home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
tcl
/
tcl70b2.lha
/
tcl7.0b2.patch
Wrap
Text File
|
1993-08-12
|
124KB
|
4,016 lines
Prereq: 100
*** ../tcl7.0b1/patchlevel.h Fri Jun 18 13:56:34 1993
--- patchlevel.h Mon Jul 19 16:48:25 1993
***************
*** 6,16 ****
* release or patch release. It's used to make sure that Tcl
* patches are applied in the correct order and only to appropriate
* sources.
- *
- * The #define below makes the patch level available from within
- * Tcl. The official level used by the "patch" program is immediately
- * below. It must use the same number as the #define.
- * PatchLevel100
*/
! #define TCL_PATCH_LEVEL 100
--- 6,11 ----
* release or patch release. It's used to make sure that Tcl
* patches are applied in the correct order and only to appropriate
* sources.
*/
! #define TCL_PATCH_LEVEL 101
*** ../tcl7.0b1/./Makefile.in Fri Jul 9 13:41:02 1993
--- ./Makefile.in Mon Jul 19 16:24:48 1993
***************
*** 15,21 ****
# Default top-level directories in which to install architecture-
# specific files (exec_prefix) and machine-independent files such
# as scripts (prefix). The values specified here may be overridden
! # at configure-time with the --exec_prefix and --prefix options
# to the "configure" script.
exec_prefix = /usr/local
--- 15,21 ----
# Default top-level directories in which to install architecture-
# specific files (exec_prefix) and machine-independent files such
# as scripts (prefix). The values specified here may be overridden
! # at configure-time with the --exec-prefix and --prefix options
# to the "configure" script.
exec_prefix = /usr/local
***************
*** 35,50 ****
# Directory in which to install the include file tcl.h:
INCLUDE_DIR = $(prefix)/include
# Directory in which to install manual entry for tclsh:
! MAN1_DIR = $(prefix)/man/man1
# Directory in which to install manual entries for Tcl's C library
# procedures:
! MAN3_DIR = $(prefix)/man/man3
# Directory in which to install manual entries for the built-in
# Tcl commands:
! MANN_DIR = $(prefix)/man/mann
# To change the compiler switches, for example to change from -O
# to -g, change the following line:
--- 35,53 ----
# Directory in which to install the include file tcl.h:
INCLUDE_DIR = $(prefix)/include
+ # Top-level directory for manual entries:
+ MAN_DIR = $(prefix)/man
+
# Directory in which to install manual entry for tclsh:
! MAN1_DIR = $(MAN_DIR)/man1
# Directory in which to install manual entries for Tcl's C library
# procedures:
! MAN3_DIR = $(MAN_DIR)/man3
# Directory in which to install manual entries for the built-in
# Tcl commands:
! MANN_DIR = $(MAN_DIR)/mann
# To change the compiler switches, for example to change from -O
# to -g, change the following line:
***************
*** 63,68 ****
--- 66,78 ----
MATH_LIBS = -lm
#MATH_LIBS =
+ # If you would like for Tcl to override the UNIX functions "setenv",
+ # "unsetenv", and "putenv", so that the "env" variable automatically
+ # gets updated whenever these functions are called, then reverse the
+ # comment characters on the following two lines:
+ ENV_FLAGS =
+ # ENV_FLAGS = -DTclSetEnv=setenv -DTclUnsetEnv=unsetenv -DTclPutEnv=putenv
+
# To compile for non-UNIX systems (so that only the non-UNIX-specific
# commands are available), reverse the comment characters on the
# following pairs of lines. In addition, you'll have to provide your
***************
*** 109,120 ****
CC = cc
CFLAGS = ${CC_SWITCHES} -I. -I${SRC_DIR} ${AC_FLAGS} ${MATH_FLAGS} \
! ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-DTCL_LIBRARY=\"${TCL_LIBRARY}\"
! GENERIC_OBJS = regexp.o tclAppInit.o tclBasic.o tclCkalloc.o tclCmdAH.o \
tclCmdIL.o tclCmdMZ.o tclExpr.o tclGet.o tclHash.o \
! tclHistory.o tclLink.o tclMtherr.o tclParse.o tclProc.o \
tclUtil.o tclVar.o
OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS}
--- 119,130 ----
CC = cc
CFLAGS = ${CC_SWITCHES} -I. -I${SRC_DIR} ${AC_FLAGS} ${MATH_FLAGS} \
! ${ENV_FLAGS} ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-DTCL_LIBRARY=\"${TCL_LIBRARY}\"
! GENERIC_OBJS = regexp.o tclBasic.o tclCkalloc.o tclCmdAH.o \
tclCmdIL.o tclCmdMZ.o tclExpr.o tclGet.o tclHash.o \
! tclHistory.o tclLink.o tclParse.o tclProc.o \
tclUtil.o tclVar.o
OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS}
***************
*** 126,149 ****
ar cr libtcl.a ${OBJS}
$(RANLIB) libtcl.a
! tclsh: libtcl.a
${CC} ${CFLAGS} tclAppInit.o libtcl.a ${MATH_LIBS} -o tclsh
! tcltest: libtcl.a tclTest.o
${CC} ${CFLAGS} tclTest.o libtcl.a ${MATH_LIBS} -o tcltest
test: tcltest
@cwd=`pwd`; \
cd $(SRC_DIR); TCL_LIBRARY=`pwd`/library; export TCL_LIBRARY; \
! cd $$cwd; ( echo cd tests\; source all ) | ./tcltest
! install: libtcl.a tclsh
! @for i in $(LIB_DIR) $(BIN_DIR) $(INCLUDE_DIR) $(TCL_LIBRARY) \
! $(MAN1_DIR) $(MAN3_DIR) $(MANN_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
! mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
--- 136,160 ----
ar cr libtcl.a ${OBJS}
$(RANLIB) libtcl.a
! tclsh: tclAppInit.o libtcl.a
${CC} ${CFLAGS} tclAppInit.o libtcl.a ${MATH_LIBS} -o tclsh
! tcltest: tclTest.o libtcl.a
${CC} ${CFLAGS} tclTest.o libtcl.a ${MATH_LIBS} -o tcltest
test: tcltest
@cwd=`pwd`; \
cd $(SRC_DIR); TCL_LIBRARY=`pwd`/library; export TCL_LIBRARY; \
! cd $$cwd; ( echo cd $(SRC_DIR)/tests\; source all ) | ./tcltest
!
! install: install-binaries install-libraries
! install-binaries: libtcl.a tclsh
! @for i in $(LIB_DIR) $(BIN_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
! mkdir $$i; \
chmod 755 $$i; \
else true; \
fi; \
***************
*** 153,158 ****
--- 164,181 ----
@$(RANLIB) $(LIB_DIR)/libtcl.a
@echo "Installing tclsh"
@$(INSTALL_PROGRAM) tclsh $(BIN_DIR)
+
+ install-libraries:
+ @for i in $(prefix)/lib $(INCLUDE_DIR) $(TCL_LIBRARY) \
+ $(MAN_DIR) $(MAN1_DIR) $(MAN3_DIR) $(MANN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
@echo "Installing tcl.h"
@$(INSTALL_DATA) $(SRC_DIR)/tcl.h $(INCLUDE_DIR)
@cd $(SRC_DIR)/library; for i in *.tcl tclIndex; \
*** ../tcl7.0b1/./tclProc.c Wed Jun 16 16:01:26 1993
--- ./tclProc.c Sat Jul 17 14:50:32 1993
***************
*** 26,32 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclProc.c,v 1.64 93/06/16 16:01:21 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
--- 26,32 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclProc.c,v 1.65 93/07/17 14:50:15 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
***************
*** 202,220 ****
* if global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
! int level, result;
CallFrame *framePtr;
- if (iPtr->varFramePtr == NULL) {
- iPtr->result = "already at top level";
- return -1;
- }
-
/*
* Parse string to figure out which level number to go to.
*/
result = 1;
if (*string == '#') {
if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
return -1;
--- 202,216 ----
* if global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
! int curLevel, level, result;
CallFrame *framePtr;
/*
* Parse string to figure out which level number to go to.
*/
result = 1;
+ curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
if (*string == '#') {
if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
return -1;
***************
*** 229,237 ****
if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
return -1;
}
! level = iPtr->varFramePtr->level - level;
} else {
! level = iPtr->varFramePtr->level - 1;
result = 0;
}
--- 225,233 ----
if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
return -1;
}
! level = curLevel - level;
} else {
! level = curLevel - 1;
result = 0;
}
*** ../tcl7.0b1/./tclVar.c Thu Jul 1 15:26:02 1993
--- ./tclVar.c Mon Jul 19 08:19:45 1993
***************
*** 29,35 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclVar.c,v 1.40 93/07/01 15:25:58 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
--- 29,35 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclVar.c,v 1.42 93/07/19 08:19:38 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
***************
*** 488,505 ****
}
/*
- * Compute how many total bytes will be needed for the
- * variable (leave space for a separating space between list
- * elements).
- */
-
- if (flags & TCL_LIST_ELEMENT) {
- length = Tcl_ScanElement(newValue, &listFlags) + 1;
- } else {
- length = strlen(newValue);
- }
-
- /*
* Clear the variable's current value unless this is an
* append operation.
*/
--- 488,493 ----
***************
*** 1665,1671 ****
if (otherPtr == NULL) {
return TCL_ERROR;
}
! hPtr = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable, myName, &new);
if (new) {
varPtr = NewVar();
Tcl_SetHashValue(hPtr, varPtr);
--- 1653,1663 ----
if (otherPtr == NULL) {
return TCL_ERROR;
}
! if (iPtr->varFramePtr != NULL) {
! hPtr = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable, myName, &new);
! } else {
! hPtr = Tcl_CreateHashEntry(&iPtr->globalTable, myName, &new);
! }
if (new) {
varPtr = NewVar();
Tcl_SetHashValue(hPtr, varPtr);
*** ../tcl7.0b1/./tclExpr.c Thu Jul 8 09:59:05 1993
--- ./tclExpr.c Mon Jul 19 15:21:25 1993
***************
*** 29,35 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.53 93/07/08 09:58:56 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
--- 29,35 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclExpr.c,v 1.56 93/07/19 15:21:13 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
***************
*** 218,225 ****
--- 218,227 ----
* libtcl.a has been processed, so Tcl's version won't be used.
*/
+ #ifdef NEED_MATHERR
extern int matherr();
int (*tclMatherrPtr)() = matherr;
+ #endif
/*
* Declarations for local procedures to this file:
***************
*** 331,346 ****
Value *valuePtr; /* Where to store value information.
* Caller must have initialized pv field. */
{
! char *term;
!
! /*
! * Try to convert the string to a number.
! */
if (*string != 0) {
valuePtr->type = TYPE_INT;
errno = 0;
! valuePtr->intValue = strtol(string, &term, 0);
if (errno == ERANGE) {
/*
* This procedure is sometimes called with string in
--- 333,361 ----
Value *valuePtr; /* Where to store value information.
* Caller must have initialized pv field. */
{
! char *term, *p;
if (*string != 0) {
valuePtr->type = TYPE_INT;
errno = 0;
!
! /*
! * Note: use strtoul instead of strtol for integer conversions
! * to allow full-size unsigned numbers, but don't depend on
! * strtoul to handle sign characters; it won't in some
! * implementations.
! */
!
! for (p = string; isspace(*p); p++) {
! /* Empty loop body. */
! }
! if (*p == '-') {
! valuePtr->intValue = -strtoul(p+1, &term, 0);
! } else if (*p == '+') {
! valuePtr->intValue = strtoul(p+1, &term, 0);
! } else {
! valuePtr->intValue = strtoul(p, &term, 0);
! }
if (errno == ERANGE) {
/*
* This procedure is sometimes called with string in
***************
*** 358,370 ****
return TCL_OK;
}
errno = 0;
! valuePtr->doubleValue = strtod(string, &term);
! if (errno != 0) {
! Tcl_ResetResult(interp);
! ExprFloatError(interp, valuePtr->doubleValue);
! return TCL_ERROR;
! }
! if (*term == '\0') {
valuePtr->type = TYPE_DOUBLE;
return TCL_OK;
}
--- 373,385 ----
return TCL_OK;
}
errno = 0;
! valuePtr->doubleValue = strtod(p, &term);
! if ((term != p) && (*term == '\0')) {
! if (errno != 0) {
! Tcl_ResetResult(interp);
! ExprFloatError(interp, valuePtr->doubleValue);
! return TCL_ERROR;
! }
valuePtr->type = TYPE_DOUBLE;
return TCL_OK;
}
***************
*** 463,473 ****
errno = 0;
valuePtr->doubleValue = strtod(p, &term2);
- if (errno != 0) {
- ExprFloatError(interp, valuePtr->doubleValue);
- return TCL_ERROR;
- }
if (term2 != p) {
infoPtr->token = VALUE;
infoPtr->expr = term2;
valuePtr->type = TYPE_DOUBLE;
--- 478,488 ----
errno = 0;
valuePtr->doubleValue = strtod(p, &term2);
if (term2 != p) {
+ if (errno != 0) {
+ ExprFloatError(interp, valuePtr->doubleValue);
+ return TCL_ERROR;
+ }
infoPtr->token = VALUE;
infoPtr->expr = term2;
valuePtr->type = TYPE_DOUBLE;
*** ../tcl7.0b1/./tclGet.c Sat Feb 6 16:20:35 1993
--- ./tclGet.c Mon Jul 12 11:35:29 1993
***************
*** 27,33 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGet.c,v 1.12 93/02/06 16:20:34 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
--- 27,33 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGet.c,v 1.13 93/07/12 11:35:14 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
***************
*** 58,67 ****
* integer in a form acceptable to strtol. */
int *intPtr; /* Place to store converted result. */
{
! char *end;
int i;
! i = strtol(string, &end, 0);
while ((*end != '\0') && isspace(*end)) {
end++;
}
--- 58,82 ----
* integer in a form acceptable to strtol. */
int *intPtr; /* Place to store converted result. */
{
! char *end, *p;
int i;
! /*
! * Note: use strtoul instead of strtol for integer conversions
! * to allow full-size unsigned numbers, but don't depend on strtoul
! * to handle sign characters; it won't in some implementations.
! */
!
! for (p = string; isspace(*p); p++) {
! /* Empty loop body. */
! }
! if (*p == '-') {
! i = -strtoul(p+1, &end, 0);
! } else if (*p == '+') {
! i = strtoul(p+1, &end, 0);
! } else {
! i = strtoul(p, &end, 0);
! }
while ((*end != '\0') && isspace(*end)) {
end++;
}
*** ../tcl7.0b1/./panic.c Sat Feb 6 16:20:44 1993
--- ./panic.c Mon Jul 12 14:01:40 1993
***************
*** 27,37 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/panic.c,v 1.4 93/02/06 16:20:43 ouster Exp $ SPRITE (Berkeley)";
#endif
#include <stdio.h>
! #include <stdlib.h>
/*
*----------------------------------------------------------------------
--- 27,41 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/panic.c,v 1.5 93/07/12 14:01:35 ouster Exp $ SPRITE (Berkeley)";
#endif
#include <stdio.h>
! #ifdef NO_STDLIB_H
! # include "compat/stdlib.h"
! #else
! # include <stdlib.h>
! #endif
/*
*----------------------------------------------------------------------
*** ../tcl7.0b1/./tclEnv.c Thu Jul 8 09:59:28 1993
--- ./tclEnv.c Mon Jul 19 10:05:56 1993
***************
*** 26,44 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.14 93/07/08 09:59:27 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
/*
! * The putenv definition below causes any system prototype for putenv
! * to be ignored so that there won't be a clash when the version of
! * putenv in this file is compiled.
*/
#define putenv ignore_putenv
#include "tclInt.h"
#include "tclUnix.h"
#undef putenv
/*
* The structure below is used to keep track of all of the interpereters
--- 26,46 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.16 93/07/19 10:05:42 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
/*
! * The putenv and setenv definitions below cause any system prototypes for
! * those procedures to be ignored so that there won't be a clash when the
! * versions in this file are compiled.
*/
#define putenv ignore_putenv
+ #define setenv ignore_setenv
#include "tclInt.h"
#include "tclUnix.h"
#undef putenv
+ #undef setenv
/*
* The structure below is used to keep track of all of the interpereters
***************
*** 76,84 ****
int flags));
static int FindVariable _ANSI_ARGS_((CONST char *name,
int *lengthPtr));
! void setenv _ANSI_ARGS_((CONST char *name,
CONST char *value));
! void unsetenv _ANSI_ARGS_((CONST char *name));
/*
*----------------------------------------------------------------------
--- 78,86 ----
int flags));
static int FindVariable _ANSI_ARGS_((CONST char *name,
int *lengthPtr));
! void TclSetEnv _ANSI_ARGS_((CONST char *name,
CONST char *value));
! void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
/*
*----------------------------------------------------------------------
***************
*** 202,212 ****
/*
*----------------------------------------------------------------------
*
! * setenv --
*
* Set an environment variable, replacing an existing value
* or creating a new variable if there doesn't exist a variable
! * by the given name.
*
* Results:
* None.
--- 204,217 ----
/*
*----------------------------------------------------------------------
*
! * TclSetEnv --
*
* Set an environment variable, replacing an existing value
* or creating a new variable if there doesn't exist a variable
! * by the given name. This procedure is intended to be a
! * stand-in for the UNIX "setenv" procedure so that applications
! * using that procedure will interface properly to Tcl. To make
! * it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
*
* Results:
* None.
***************
*** 219,225 ****
*/
void
! setenv(name, value)
CONST char *name; /* Name of variable whose value is to be
* set. */
CONST char *value; /* New value for variable. */
--- 224,230 ----
*/
void
! TclSetEnv(name, value)
CONST char *name; /* Name of variable whose value is to be
* set. */
CONST char *value; /* New value for variable. */
***************
*** 294,307 ****
/*
*----------------------------------------------------------------------
*
! * putenv --
*
* Set an environment variable. Similar to setenv except that
* the information is passed in a single string of the form
* NAME=value, rather than as separate name strings. This procedure
! * is a stand-in for the standard UNIX procedure by the same name,
* so that applications using that procedure will interface
! * properly to Tcl.
*
* Results:
* None.
--- 299,313 ----
/*
*----------------------------------------------------------------------
*
! * Tcl_PutEnv --
*
* Set an environment variable. Similar to setenv except that
* the information is passed in a single string of the form
* NAME=value, rather than as separate name strings. This procedure
! * is intended to be a stand-in for the UNIX "putenv" procedure
* so that applications using that procedure will interface
! * properly to Tcl. To make it a stand-in, the Makefile will
! * define "Tcl_PutEnv" to "putenv".
*
* Results:
* None.
***************
*** 314,320 ****
*/
int
! putenv(string)
CONST char *string; /* Info about environment variable in the
* form NAME=value. */
{
--- 320,326 ----
*/
int
! Tcl_PutEnv(string)
CONST char *string; /* Info about environment variable in the
* form NAME=value. */
{
***************
*** 327,333 ****
/*
* Separate the string into name and value parts, then call
! * setenv to do all of the real work.
*/
value = strchr(string, '=');
--- 333,339 ----
/*
* Separate the string into name and value parts, then call
! * TclSetEnv to do all of the real work.
*/
value = strchr(string, '=');
***************
*** 341,347 ****
name = ckalloc((unsigned) nameLength+1);
memcpy(name, string, nameLength);
name[nameLength] = 0;
! setenv(name, value+1);
ckfree(name);
return 0;
}
--- 347,353 ----
name = ckalloc((unsigned) nameLength+1);
memcpy(name, string, nameLength);
name[nameLength] = 0;
! TclSetEnv(name, value+1);
ckfree(name);
return 0;
}
***************
*** 349,358 ****
/*
*----------------------------------------------------------------------
*
! * unsetenv --
*
* Remove an environment variable, updating the "env" arrays
! * in all interpreters managed by us.
*
* Results:
* None.
--- 355,367 ----
/*
*----------------------------------------------------------------------
*
! * TclUnsetEnv --
*
* Remove an environment variable, updating the "env" arrays
! * in all interpreters managed by us. This function is intended
! * to replace the UNIX "unsetenv" function (but to do this the
! * Makefile must be modified to redefine "TclUnsetEnv" to
! * "unsetenv".
*
* Results:
* None.
***************
*** 364,370 ****
*/
void
! unsetenv(name)
CONST char *name; /* Name of variable to remove. */
{
int index, dummy;
--- 373,379 ----
*/
void
! TclUnsetEnv(name)
CONST char *name; /* Name of variable to remove. */
{
int index, dummy;
***************
*** 466,480 ****
}
/*
! * If a value is being set, call setenv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
! setenv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
}
if (flags & TCL_TRACE_UNSETS) {
! unsetenv(name2);
}
return NULL;
}
--- 475,489 ----
}
/*
! * If a value is being set, call TclSetEnv to do all of the work.
*/
if (flags & TCL_TRACE_WRITES) {
! TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
}
if (flags & TCL_TRACE_UNSETS) {
! TclUnsetEnv(name2);
}
return NULL;
}
*** ../tcl7.0b1/./tclMtherr.c Thu Jun 3 10:36:37 1993
--- ./tclMtherr.c Mon Jul 19 15:21:09 1993
***************
*** 26,38 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMtherr.c,v 1.3 93/06/03 10:36:22 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
- #ifndef TCL_NO_MATH
#include <math.h>
- #endif
/*
* The stuff below is a bit of a hack so that this file can be used
--- 26,36 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclMtherr.c,v 1.4 93/07/19 14:58:45 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
#include <math.h>
/*
* The stuff below is a bit of a hack so that this file can be used
***************
*** 57,76 ****
extern int tcl_MathInProgress;
- /*
- * Define a dummy "struct exception" structure if none already exists.
- * The "OVERFLOW" #define is tested to see whether matherr stuff has
- * been defined in math.h (struct exception is only defined if the
- * matherr stuff is defined).
- */
-
- #ifndef OVERFLOW
- struct exception {
- int type;
- };
- #define DOMAIN 0
- #define SING 1
- #endif
/*
*----------------------------------------------------------------------
--- 55,60 ----
*** ../tcl7.0b1/./tclCmdAH.c Thu Jun 17 15:23:35 1993
--- ./tclCmdAH.c Sat Jul 17 15:25:38 1993
***************
*** 27,33 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclCmdAH.c,v 1.89 93/06/17 11:23:06 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
--- 27,33 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclCmdAH.c,v 1.90 93/07/17 15:25:20 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
***************
*** 835,851 ****
goto badIndex;
}
switch (*format) {
! case 'D':
! case 'O':
! case 'U':
! if (!useShort) {
! newPtr++;
! } else {
! useShort = 0;
! }
! newPtr[-1] = tolower(*format);
! newPtr[-2] = 'l';
! *newPtr = 0;
case 'd':
case 'o':
case 'u':
--- 835,842 ----
goto badIndex;
}
switch (*format) {
! case 'i':
! newPtr[-1] = 'd';
case 'd':
case 'o':
case 'u':
***************
*** 868,875 ****
}
size = 1;
break;
- case 'F':
- newPtr[-1] = tolower(newPtr[-1]);
case 'e':
case 'E':
case 'f':
--- 859,864 ----
*** ../tcl7.0b1/./tclCmdMZ.c Thu Jun 17 13:33:35 1993
--- ./tclCmdMZ.c Fri Jul 16 16:51:35 1993
***************
*** 28,34 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclCmdMZ.c,v 1.32 93/06/17 13:33:28 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
--- 28,34 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclCmdMZ.c,v 1.34 93/07/16 16:50:50 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tclInt.h"
***************
*** 536,565 ****
char **argv; /* Argument strings. */
{
Interp *iPtr = (Interp *) interp;
! int c;
! if (argc > 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
! " ?value? ?code?\"", (char *) NULL);
return TCL_ERROR;
}
! if (argc >= 2) {
! Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
! }
! iPtr->returnCode = TCL_OK;
! if (argc == 3) {
c = argv[2][0];
if ((c == 'o') && (strcmp(argv[2], "ok") == 0)) {
! iPtr->returnCode = TCL_OK;
} else if ((c == 'e') && (strcmp(argv[2], "error") == 0)) {
! iPtr->returnCode = TCL_ERROR;
} else if ((c == 'r') && (strcmp(argv[2], "return") == 0)) {
! iPtr->returnCode = TCL_RETURN;
} else if ((c == 'b') && (strcmp(argv[2], "break") == 0)) {
! iPtr->returnCode = TCL_BREAK;
} else if ((c == 'c') && (strcmp(argv[2], "continue") == 0)) {
! iPtr->returnCode = TCL_CONTINUE;
! } else if (Tcl_GetInt(interp, argv[2], &iPtr->returnCode) != TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad completion code \"",
argv[2], "\": must be ok, error, return, break, ",
--- 536,566 ----
char **argv; /* Argument strings. */
{
Interp *iPtr = (Interp *) interp;
! int c, code;
! if (argc > 4) {
! syntaxError:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
! " ?-code code? ?string?\"", (char *) NULL);
return TCL_ERROR;
}
! code = TCL_OK;
! if (argc >= 3) {
! if (strcmp(argv[1], "-code") != 0) {
! goto syntaxError;
! }
c = argv[2][0];
if ((c == 'o') && (strcmp(argv[2], "ok") == 0)) {
! code = TCL_OK;
} else if ((c == 'e') && (strcmp(argv[2], "error") == 0)) {
! code = TCL_ERROR;
} else if ((c == 'r') && (strcmp(argv[2], "return") == 0)) {
! code = TCL_RETURN;
} else if ((c == 'b') && (strcmp(argv[2], "break") == 0)) {
! code = TCL_BREAK;
} else if ((c == 'c') && (strcmp(argv[2], "continue") == 0)) {
! code = TCL_CONTINUE;
! } else if (Tcl_GetInt(interp, argv[2], &code) != TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad completion code \"",
argv[2], "\": must be ok, error, return, break, ",
***************
*** 566,573 ****
"continue, or an integer", (char *) NULL);
return TCL_ERROR;
}
}
!
return TCL_RETURN;
}
--- 567,579 ----
"continue, or an integer", (char *) NULL);
return TCL_ERROR;
}
+ if (argc == 4) {
+ Tcl_SetResult(interp, argv[3], TCL_VOLATILE);
+ }
+ } else if (argc == 2) {
+ Tcl_SetResult(interp, argv[1], TCL_VOLATILE);
}
! iPtr->returnCode = code;
return TCL_RETURN;
}
***************
*** 615,625 ****
* suppressed. */
int totalSize = 0; /* Number of bytes needed to store
* all results combined. */
! char *results; /* Where scanned output goes. */
int numScanned; /* sscanf's result. */
register char *fmt;
! int i, widthSpecified;
if (argc < 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" string format ?varName varName ...?\"", (char *) NULL);
--- 621,643 ----
* suppressed. */
int totalSize = 0; /* Number of bytes needed to store
* all results combined. */
! char *results; /* Where scanned output goes.
! * Malloced; NULL means not allocated
! * yet. */
int numScanned; /* sscanf's result. */
register char *fmt;
! int i, widthSpecified, length, code;
!
! /*
! * The variables below are used to hold a copy of the format
! * string, so that we can replace format specifiers like "%f"
! * and "%F" with specifiers like "%lf"
! */
+ # define STATIC_SIZE 5
+ char copyBuf[STATIC_SIZE], *fmtCopy;
+ register char *dst;
+
if (argc < 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" string format ?varName varName ...?\"", (char *) NULL);
***************
*** 635,651 ****
--- 653,684 ----
* 4. Pick off the fields from the array and assign them to variables.
*/
+ code = TCL_OK;
+ results = NULL;
arg1Length = (strlen(argv[1]) + 4) & ~03;
+ length = strlen(argv[2]) * 2 + 1;
+ if (length < STATIC_SIZE) {
+ fmtCopy = copyBuf;
+ } else {
+ fmtCopy = ckalloc((unsigned) length);
+ }
+ dst = fmtCopy;
for (fmt = argv[2]; *fmt != 0; fmt++) {
+ *dst = *fmt;
+ dst++;
if (*fmt != '%') {
continue;
}
fmt++;
if (*fmt == '%') {
+ *dst = *fmt;
+ dst++;
continue;
}
if (*fmt == '*') {
suppress = 1;
+ *dst = *fmt;
+ dst++;
fmt++;
} else {
suppress = 0;
***************
*** 653,674 ****
widthSpecified = 0;
while (isdigit(*fmt)) {
widthSpecified = 1;
fmt++;
}
if (suppress) {
continue;
}
if (numFields == MAX_FIELDS) {
interp->result = "too many fields to scan";
! return TCL_ERROR;
}
curField = &fields[numFields];
numFields++;
switch (*fmt) {
- case 'D':
- case 'O':
- case 'X':
case 'd':
case 'o':
case 'x':
curField->fmt = 'd';
--- 686,713 ----
widthSpecified = 0;
while (isdigit(*fmt)) {
widthSpecified = 1;
+ *dst = *fmt;
+ dst++;
+ fmt++;
+ }
+ if ((*fmt == 'l') || (*fmt == 'h') || (*fmt == 'L')) {
fmt++;
}
+ *dst = *fmt;
+ dst++;
if (suppress) {
continue;
}
if (numFields == MAX_FIELDS) {
interp->result = "too many fields to scan";
! code = TCL_ERROR;
! goto done;
}
curField = &fields[numFields];
numFields++;
switch (*fmt) {
case 'd':
+ case 'i':
case 'o':
case 'x':
curField->fmt = 'd';
***************
*** 675,680 ****
--- 714,724 ----
curField->size = sizeof(int);
break;
+ case 'u':
+ curField->fmt = 'u';
+ curField->size = sizeof(int);
+ break;
+
case 's':
curField->fmt = 's';
curField->size = arg1Length;
***************
*** 684,705 ****
if (widthSpecified) {
interp->result =
"field width may not be specified in %c conversion";
! return TCL_ERROR;
}
curField->fmt = 'c';
curField->size = sizeof(int);
break;
- case 'E':
- case 'F':
- curField->fmt = 'F';
- curField->size = sizeof(double);
- break;
-
case 'e':
case 'f':
curField->fmt = 'f';
! curField->size = sizeof(float);
break;
case '[':
--- 728,748 ----
if (widthSpecified) {
interp->result =
"field width may not be specified in %c conversion";
! code = TCL_ERROR;
! goto done;
}
curField->fmt = 'c';
curField->size = sizeof(int);
break;
case 'e':
case 'f':
+ case 'g':
+ dst[-1] = 'l';
+ dst[0] = 'f';
+ dst++;
curField->fmt = 'f';
! curField->size = sizeof(double);
break;
case '[':
***************
*** 707,712 ****
--- 750,757 ----
curField->size = arg1Length;
do {
fmt++;
+ *dst = *fmt;
+ dst++;
} while (*fmt != ']');
break;
***************
*** 713,727 ****
default:
sprintf(interp->result, "bad scan conversion character \"%c\"",
*fmt);
! return TCL_ERROR;
}
totalSize += curField->size;
}
if (numFields != (argc-3)) {
interp->result =
"different numbers of variable names and field specifiers";
! return TCL_ERROR;
}
/*
--- 758,775 ----
default:
sprintf(interp->result, "bad scan conversion character \"%c\"",
*fmt);
! code = TCL_ERROR;
! goto done;
}
totalSize += curField->size;
}
+ *dst = 0;
if (numFields != (argc-3)) {
interp->result =
"different numbers of variable names and field specifiers";
! code = TCL_ERROR;
! goto done;
}
/*
***************
*** 749,755 ****
* Step 3:
*/
! numScanned = sscanf(argv[1], argv[2],
fields[0].location, fields[1].location, fields[2].location,
fields[3].location, fields[4].location, fields[5].location,
fields[6].location, fields[7].location, fields[8].location,
--- 797,803 ----
* Step 3:
*/
! numScanned = sscanf(argv[1], fmtCopy,
fields[0].location, fields[1].location, fields[2].location,
fields[3].location, fields[4].location, fields[5].location,
fields[6].location, fields[7].location, fields[8].location,
***************
*** 776,783 ****
Tcl_AppendResult(interp,
"couldn't set variable \"", argv[i+3], "\"",
(char *) NULL);
! ckfree((char *) results);
! return TCL_ERROR;
}
break;
--- 824,838 ----
Tcl_AppendResult(interp,
"couldn't set variable \"", argv[i+3], "\"",
(char *) NULL);
! code = TCL_ERROR;
! goto done;
! }
! break;
!
! case 'u':
! sprintf(string, "%u", *((int *) curField->location));
! if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
! goto storeError;
}
break;
***************
*** 795,810 ****
}
break;
- case 'F':
- Tcl_PrintDouble(interp, *((double *) curField->location),
- string);
- if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
- goto storeError;
- }
- break;
-
case 'f':
! Tcl_PrintDouble(interp, *((float *) curField->location),
string);
if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
goto storeError;
--- 850,857 ----
}
break;
case 'f':
! Tcl_PrintDouble(interp, *((double *) curField->location),
string);
if (Tcl_SetVar(interp, argv[i+3], string, 0) == NULL) {
goto storeError;
***************
*** 812,820 ****
break;
}
}
- ckfree(results);
sprintf(interp->result, "%d", numScanned);
! return TCL_OK;
}
/*
--- 859,873 ----
break;
}
}
sprintf(interp->result, "%d", numScanned);
! done:
! if (results != NULL) {
! ckfree(results);
! }
! if (fmtCopy != copyBuf) {
! ckfree(fmtCopy);
! }
! return code;
}
/*
*** ../tcl7.0b1/./tclCkalloc.c Thu Jun 3 15:08:02 1993
--- ./tclCkalloc.c Thu Jul 15 16:42:56 1993
***************
*** 260,271 ****
}
/*
! * Fill in guard zones and size. Link into allocated list.
*/
result->length = size;
result->file = file;
result->line = line;
memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
result->flink = allocHead;
result->blink = NULL;
--- 260,274 ----
}
/*
! * Fill in guard zones and size. Also initialize the contents of
! * the block with bogus bytes to detect uses of initialized data.
! * Link into allocated list.
*/
result->length = size;
result->file = file;
result->line = line;
memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
+ memset (result->body, GUARD_VALUE, size);
memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
result->flink = allocHead;
result->blink = NULL;
*** ../tcl7.0b1/./tcl.h Wed Jul 7 16:24:42 1993
--- ./tcl.h Mon Jul 19 16:07:29 1993
***************
*** 24,30 ****
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*
! * $Header: /user6/ouster/tcl/RCS/tcl.h,v 1.116 93/07/07 16:24:40 ouster Exp $ SPRITE (Berkeley)
*/
#ifndef _TCL
--- 24,30 ----
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*
! * $Header: /user6/ouster/tcl/RCS/tcl.h,v 1.117 93/07/19 08:47:25 ouster Exp $ SPRITE (Berkeley)
*/
#ifndef _TCL
***************
*** 88,94 ****
#endif
#ifndef _CLIENTDATA
! typedef int *ClientData;
#define _CLIENTDATA
#endif
--- 88,98 ----
#endif
#ifndef _CLIENTDATA
! # ifdef __STDC__
! typedef void *ClientData;
! # else
! typedef int *ClientData;
! # endif /* __STDC__ */
#define _CLIENTDATA
#endif
*** ../tcl7.0b1/./tclUnix.h Thu Jul 8 09:59:27 1993
--- ./tclUnix.h Mon Jul 19 16:08:14 1993
***************
*** 31,37 ****
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*
! * $Header: /user6/ouster/tcl/RCS/tclUnix.h,v 1.41 93/07/08 09:59:26 ouster Exp $ SPRITE (Berkeley)
*/
#ifndef _TCLUNIX
--- 31,37 ----
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*
! * $Header: /user6/ouster/tcl/RCS/tclUnix.h,v 1.43 93/07/19 16:08:04 ouster Exp $ SPRITE (Berkeley)
*/
#ifndef _TCLUNIX
***************
*** 62,71 ****
#ifndef NO_SYS_WAIT_H
# include <sys/wait.h>
#endif
! #ifndef HAVE_UNISTD
# include <unistd.h>
#else
! # include <compat/unistd.h>
#endif
/*
--- 62,71 ----
#ifndef NO_SYS_WAIT_H
# include <sys/wait.h>
#endif
! #ifdef HAVE_UNISTD_H
# include <unistd.h>
#else
! # include "compat/unistd.h"
#endif
/*
*** ../tcl7.0b1/./configure Thu Jun 17 15:52:16 1993
--- ./configure Mon Jul 19 15:22:46 1993
***************
*** 1,4 ****
-
#!/bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf.
--- 1,3 ----
***************
*** 158,163 ****
--- 157,166 ----
test -z "$RANLIB" && RANLIB="@:"
+ #--------------------------------------------------------------------
+ # Supply substitutes for missing POSIX library procedures, or
+ # set flags so Tcl uses alternate procedures.
+ #--------------------------------------------------------------------
for func in getcwd opendir strerror strstr strtod
do
***************
*** 261,267 ****
#endif
!
echo checking for unistd.h
echo checking how to run the C preprocessor
--- 264,278 ----
#endif
! #--------------------------------------------------------------------
! # Supply substitutes for missing POSIX header files. Special
! # notes:
! # - Sprite's dirent.h exists but is bogus.
! # - stdlib.h doesn't define strtol, strtoul, or
! # strtod insome versions of SunOS
! # - some versions of string.h don't declare procedures such
! # as strstr
! #--------------------------------------------------------------------
echo checking for unistd.h
echo checking how to run the C preprocessor
***************
*** 304,316 ****
}
EOF
if eval $compile; then
! :
else
! DEFS="$DEFS -DNO_DIRENT_H=1"
fi
rm -f conftest*
! echo '#include <DEFS="$DEFS -DNO_DIRENT_H=1">' > conftest.c
eval "$CPP $DEFS conftest.c > conftest.out 2>&1"
if egrep "Sprite version.* NOT POSIX" conftest.out >/dev/null 2>&1; then
:
--- 315,327 ----
}
EOF
if eval $compile; then
! tcl_ok=1
else
! tcl_ok=0
fi
rm -f conftest*
! echo '#include <tcl_ok=0>' > conftest.c
eval "$CPP $DEFS conftest.c > conftest.out 2>&1"
if egrep "Sprite version.* NOT POSIX" conftest.out >/dev/null 2>&1; then
:
***************
*** 317,322 ****
--- 328,334 ----
fi
rm -f conftest*
+ if test $tcl_ok = 0; then DEFS="$DEFS -DNO_DIRENT_H=1"; fi
echo checking for float.h
cat > conftest.c <<EOF
#include <float.h>
***************
*** 347,355 ****
EOF
err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"`
if test -z "$err"; then
! :
else
! DEFS="$DEFS -DNO_STDLIB_H=1"
fi
rm -f conftest*
--- 359,367 ----
EOF
err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"`
if test -z "$err"; then
! tcl_ok=1
else
! tcl_ok=0
fi
rm -f conftest*
***************
*** 358,364 ****
if egrep "strtol" conftest.out >/dev/null 2>&1; then
:
else
! DEFS="$DEFS -DNO_STDLIB_H=1"
fi
rm -f conftest*
--- 370,376 ----
if egrep "strtol" conftest.out >/dev/null 2>&1; then
:
else
! tcl_ok=0
fi
rm -f conftest*
***************
*** 367,373 ****
if egrep "strtoul" conftest.out >/dev/null 2>&1; then
:
else
! DEFS="$DEFS -DNO_STDLIB_H=1"
fi
rm -f conftest*
--- 379,385 ----
if egrep "strtoul" conftest.out >/dev/null 2>&1; then
:
else
! tcl_ok=0
fi
rm -f conftest*
***************
*** 376,385 ****
if egrep "strtod" conftest.out >/dev/null 2>&1; then
:
else
! DEFS="$DEFS -DNO_STDLIB_H=1"
fi
rm -f conftest*
echo checking for string.h
cat > conftest.c <<EOF
#include <string.h>
--- 388,398 ----
if egrep "strtod" conftest.out >/dev/null 2>&1; then
:
else
! tcl_ok=0
fi
rm -f conftest*
+ if test $tcl_ok = 0; then DEFS="$DEFS -DNO_STDLIB_H=1"; fi
echo checking for string.h
cat > conftest.c <<EOF
#include <string.h>
***************
*** 386,394 ****
EOF
err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"`
if test -z "$err"; then
! :
else
! DEFS="$DEFS -DNO_STRING_H=1"
fi
rm -f conftest*
--- 399,407 ----
EOF
err=`eval "$CPP $DEFS conftest.c 2>&1 >/dev/null"`
if test -z "$err"; then
! tcl_ok=1
else
! tcl_ok=0
fi
rm -f conftest*
***************
*** 397,403 ****
if egrep "strstr" conftest.out >/dev/null 2>&1; then
:
else
! DEFS="$DEFS -DNO_STRING_H=1"
fi
rm -f conftest*
--- 410,416 ----
if egrep "strstr" conftest.out >/dev/null 2>&1; then
:
else
! tcl_ok=0
fi
rm -f conftest*
***************
*** 406,415 ****
if egrep "strerror" conftest.out >/dev/null 2>&1; then
:
else
! DEFS="$DEFS -DNO_STRING_H=1"
fi
rm -f conftest*
echo checking for sys/time.h
cat > conftest.c <<EOF
#include <sys/time.h>
--- 419,429 ----
if egrep "strerror" conftest.out >/dev/null 2>&1; then
:
else
! tcl_ok=0
fi
rm -f conftest*
+ if test $tcl_ok = 0; then DEFS="$DEFS -DNO_STRING_H=1"; fi
echo checking for sys/time.h
cat > conftest.c <<EOF
#include <sys/time.h>
***************
*** 435,440 ****
--- 449,458 ----
rm -f conftest*
+ #--------------------------------------------------------------------
+ # On some systems strstr is broken: it returns a pointer even
+ # even if the original string is empty.
+ #--------------------------------------------------------------------
cat > conftest.c <<EOF
***************
*** 453,458 ****
--- 471,480 ----
fi
rm -f conftest*
+ #--------------------------------------------------------------------
+ # Under some versions of AIX strtoul returns an incorrect terminator
+ # pointer for the string "0".
+ #--------------------------------------------------------------------
cat > conftest.c <<EOF
***************
*** 477,482 ****
--- 499,518 ----
fi
rm -f conftest*
+ #--------------------------------------------------------------------
+ # Check for various typedefs and provide substitutes if
+ # they don't exist.
+ #--------------------------------------------------------------------
+
+ echo checking for mode_t in sys/types.h
+ echo '#include <sys/types.h>' > conftest.c
+ eval "$CPP $DEFS conftest.c > conftest.out 2>&1"
+ if egrep "mode_t" conftest.out >/dev/null 2>&1; then
+ :
+ else
+ DEFS="$DEFS -Dmode_t=int"
+ fi
+ rm -f conftest*
echo checking for pid_t in sys/types.h
echo '#include <sys/types.h>' > conftest.c
***************
*** 488,493 ****
--- 524,539 ----
fi
rm -f conftest*
+ echo checking for size_t in sys/types.h
+ echo '#include <sys/types.h>' > conftest.c
+ eval "$CPP $DEFS conftest.c > conftest.out 2>&1"
+ if egrep "size_t" conftest.out >/dev/null 2>&1; then
+ :
+ else
+ DEFS="$DEFS -Dsize_t=unsigned"
+ fi
+ rm -f conftest*
+
echo checking for uid_t in sys/types.h
echo '#include <sys/types.h>' > conftest.c
eval "$CPP $DEFS conftest.c > conftest.out 2>&1"
***************
*** 499,504 ****
--- 545,556 ----
rm -f conftest*
+ #--------------------------------------------------------------------
+ # If a system doesn't have an opendir function (man, that's old!)
+ # then we have to supply a different version of dirent.h which
+ # is compatible with the substitute version of opendir that's
+ # provided. This version only works with V7-style directories.
+ #--------------------------------------------------------------------
echo checking for opendir
cat > conftest.c <<EOF
***************
*** 522,527 ****
--- 574,584 ----
#endif
+ #--------------------------------------------------------------------
+ # Check for the existence of sys_errlist (this is only needed if
+ # there's no strerror, but I don't know how to conditionalize the
+ # check).
+ #--------------------------------------------------------------------
echo checking for sys_errlist
cat > conftest.c <<EOF
***************
*** 541,546 ****
--- 598,610 ----
rm -f conftest*
+ #--------------------------------------------------------------------
+ # The check below checks whether <sys/wait.h> defines the type
+ # "union wait" correctly. It's needed because of weirdness in
+ # HP-UX where "union wait" is defined in both the BSD and SYS-V
+ # environments. Checking the usability of WIFEXITED seems to do
+ # the trick.
+ #--------------------------------------------------------------------
echo checking for union wait
cat > conftest.c <<EOF
***************
*** 561,576 ****
rm -f conftest*
! newDefs=""
! for i in $DEFS; do
! if test -z "$newDefs"; then
! newDefs=$i
! elif echo $newDefs | fgrep -v -e $i >/dev/null 2>&1; then
! newDefs="$newDefs $i"
! fi
! done
! DEFS=$newDefs
if test -n "$prefix"; then
test -z "$exec_prefix" && exec_prefix='${prefix}'
--- 625,650 ----
rm -f conftest*
+ #--------------------------------------------------------------------
+ # Check to see whether the system supports the matherr function
+ # and its associated type "struct exception".
+ #--------------------------------------------------------------------
! echo checking for matherr support
! cat > conftest.c <<EOF
! #include <math.h>
! main() { exit(0); }
! t() {
! struct exception x;
! x.type = DOMAIN;
! x.type = SING;
! }
! EOF
! if eval $compile; then
! LIBOBJS="$LIBOBJS tclMtherr.o"; DEFS="$DEFS -DNEED_MATHERR=1"
! fi
! rm -f conftest*
!
if test -n "$prefix"; then
test -z "$exec_prefix" && exec_prefix='${prefix}'
*** ../tcl7.0b1/./configure.in Thu Jun 3 15:39:17 1993
--- ./configure.in Mon Jul 19 15:21:41 1993
***************
*** 1,15 ****
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
-
AC_INIT(tcl.h)
AC_PROG_INSTALL
AC_PROG_RANLIB
! dnl--------------------------------------------------------------------
! dnl Supply substitutes for missing POSIX library procedures, or set
! dnl flags so Tcl uses alternate procedures.
! dnl--------------------------------------------------------------------
AC_REPLACE_FUNCS(getcwd opendir strerror strstr strtod)
AC_REPLACE_FUNCS(strtol strtoul tmpnam waitpid)
--- 1,14 ----
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
AC_INIT(tcl.h)
AC_PROG_INSTALL
AC_PROG_RANLIB
! #--------------------------------------------------------------------
! # Supply substitutes for missing POSIX library procedures, or
! # set flags so Tcl uses alternate procedures.
! #--------------------------------------------------------------------
AC_REPLACE_FUNCS(getcwd opendir strerror strstr strtod)
AC_REPLACE_FUNCS(strtol strtoul tmpnam waitpid)
***************
*** 17,32 ****
AC_FUNC_CHECK(getwd, , AC_DEFINE(NO_GETWD))
AC_FUNC_CHECK(wait3, , AC_DEFINE(NO_WAIT3))
!
! dnl--------------------------------------------------------------------
! dnl Supply substitutes for missing POSIX header files. Special
! dnl notes:
! dnl - Sprite's dirent.h exists but is bogus.
! dnl - stdlib.h doesn't define strtol, strtoul, or
! dnl strtod insome versions of SunOS
! dnl - some versions of string.h don't declare procedures such
! dnl as strstr
! dnl--------------------------------------------------------------------
AC_UNISTD_H
AC_COMPILE_CHECK(dirent.h, [#include <sys/types.h>
--- 16,30 ----
AC_FUNC_CHECK(getwd, , AC_DEFINE(NO_GETWD))
AC_FUNC_CHECK(wait3, , AC_DEFINE(NO_WAIT3))
! #--------------------------------------------------------------------
! # Supply substitutes for missing POSIX header files. Special
! # notes:
! # - Sprite's dirent.h exists but is bogus.
! # - stdlib.h doesn't define strtol, strtoul, or
! # strtod insome versions of SunOS
! # - some versions of string.h don't declare procedures such
! # as strstr
! #--------------------------------------------------------------------
AC_UNISTD_H
AC_COMPILE_CHECK(dirent.h, [#include <sys/types.h>
***************
*** 38,61 ****
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);
! ], , AC_DEFINE(NO_DIRENT_H))
! AC_HEADER_EGREP([Sprite version.* NOT POSIX], AC_DEFINE(NO_DIRENT_H))
AC_HEADER_CHECK(float.h, , AC_DEFINE(NO_FLOAT_H))
AC_HEADER_CHECK(limits.h, , AC_DEFINE(NO_LIMITS_H))
! AC_HEADER_CHECK(stdlib.h, , AC_DEFINE(NO_STDLIB_H))
! AC_HEADER_EGREP(strtol, stdlib.h, , AC_DEFINE(NO_STDLIB_H))
! AC_HEADER_EGREP(strtoul, stdlib.h, , AC_DEFINE(NO_STDLIB_H))
! AC_HEADER_EGREP(strtod, stdlib.h, , AC_DEFINE(NO_STDLIB_H))
! AC_HEADER_CHECK(string.h, , AC_DEFINE(NO_STRING_H))
! AC_HEADER_EGREP(strstr, string.h, , AC_DEFINE(NO_STRING_H))
! AC_HEADER_EGREP(strerror, string.h, , AC_DEFINE(NO_STRING_H))
AC_HEADER_CHECK(sys/time.h, , AC_DEFINE(NO_SYS_TIME_H))
AC_HEADER_CHECK(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
! dnl--------------------------------------------------------------------
! dnl On some systems strstr is broken: it returns a pointer even
! dnl even if the original string is empty.
! dnl--------------------------------------------------------------------
AC_TEST_PROGRAM([
extern int strstr();
--- 36,62 ----
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);
! ], tcl_ok=1, tcl_ok=0)
! AC_HEADER_EGREP([Sprite version.* NOT POSIX], tcl_ok=0)
! if test $tcl_ok = 0; then AC_DEFINE(NO_DIRENT_H); fi
AC_HEADER_CHECK(float.h, , AC_DEFINE(NO_FLOAT_H))
AC_HEADER_CHECK(limits.h, , AC_DEFINE(NO_LIMITS_H))
! AC_HEADER_CHECK(stdlib.h, tcl_ok=1, tcl_ok=0)
! AC_HEADER_EGREP(strtol, stdlib.h, , tcl_ok=0)
! AC_HEADER_EGREP(strtoul, stdlib.h, , tcl_ok=0)
! AC_HEADER_EGREP(strtod, stdlib.h, , tcl_ok=0)
! if test $tcl_ok = 0; then AC_DEFINE(NO_STDLIB_H); fi
! AC_HEADER_CHECK(string.h, tcl_ok=1, tcl_ok=0)
! AC_HEADER_EGREP(strstr, string.h, , tcl_ok=0)
! AC_HEADER_EGREP(strerror, string.h, , tcl_ok=0)
! if test $tcl_ok = 0; then AC_DEFINE(NO_STRING_H); fi
AC_HEADER_CHECK(sys/time.h, , AC_DEFINE(NO_SYS_TIME_H))
AC_HEADER_CHECK(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
! #--------------------------------------------------------------------
! # On some systems strstr is broken: it returns a pointer even
! # even if the original string is empty.
! #--------------------------------------------------------------------
AC_TEST_PROGRAM([
extern int strstr();
***************
*** 65,74 ****
}
], , [LIBOBJS="$LIBOBJS strstr.o"])
! dnl--------------------------------------------------------------------
! dnl Under some versions of AIX strtoul returns an incorrect terminator
! dnl pointer for the string "0".
! dnl--------------------------------------------------------------------
AC_TEST_PROGRAM([
extern int strtoul();
--- 66,75 ----
}
], , [LIBOBJS="$LIBOBJS strstr.o"])
! #--------------------------------------------------------------------
! # Under some versions of AIX strtoul returns an incorrect terminator
! # pointer for the string "0".
! #--------------------------------------------------------------------
AC_TEST_PROGRAM([
extern int strtoul();
***************
*** 84,110 ****
exit(0);
}], , [LIBOBJS="$LIBOBJS strtoul.o"])
! dnl--------------------------------------------------------------------
! dnl Check for missing pid_t and uid_t typedefs.
! dnl--------------------------------------------------------------------
AC_PID_T
AC_UID_T
! dnl--------------------------------------------------------------------
! dnl If a system doesn't have an opendir function (man, that's old!)
! dnl then we have to supply a different version of dirent.h which
! dnl is compatible with the substitute version of opendir that's
! dnl provided. This version only works with V7-style directories.
! dnl--------------------------------------------------------------------
AC_FUNC_CHECK(opendir, , AC_DEFINE(USE_DIRENT2_H))
! dnl--------------------------------------------------------------------
! dnl Check for the existence of sys_errlist (this is only needed if
! dnl there's no strerror, but I don't know how to conditionalize the
! dnl check).
! dnl--------------------------------------------------------------------
AC_COMPILE_CHECK(sys_errlist, , [
extern char *sys_errlist[];
--- 85,114 ----
exit(0);
}], , [LIBOBJS="$LIBOBJS strtoul.o"])
! #--------------------------------------------------------------------
! # Check for various typedefs and provide substitutes if
! # they don't exist.
! #--------------------------------------------------------------------
+ AC_MODE_T
AC_PID_T
+ AC_SIZE_T
AC_UID_T
! #--------------------------------------------------------------------
! # If a system doesn't have an opendir function (man, that's old!)
! # then we have to supply a different version of dirent.h which
! # is compatible with the substitute version of opendir that's
! # provided. This version only works with V7-style directories.
! #--------------------------------------------------------------------
AC_FUNC_CHECK(opendir, , AC_DEFINE(USE_DIRENT2_H))
! #--------------------------------------------------------------------
! # Check for the existence of sys_errlist (this is only needed if
! # there's no strerror, but I don't know how to conditionalize the
! # check).
! #--------------------------------------------------------------------
AC_COMPILE_CHECK(sys_errlist, , [
extern char *sys_errlist[];
***************
*** 112,124 ****
sys_errlist[sys_nerr-1][0] = 0;
], , AC_DEFINE(NO_SYS_ERRLIST))
! dnl--------------------------------------------------------------------
! dnl The check below checks whether <sys/wait.h> defines the type
! dnl "union wait" correctly. It's needed because of weirdness in
! dnl HP-UX where "union wait" is defined in both the BSD and SYS-V
! dnl environments. Checking the usability of WIFEXITED seems to do
! dnl the trick.
! dnl--------------------------------------------------------------------
AC_COMPILE_CHECK([union wait], [#include <sys/types.h>
#include <sys/wait.h>], [
--- 116,128 ----
sys_errlist[sys_nerr-1][0] = 0;
], , AC_DEFINE(NO_SYS_ERRLIST))
! #--------------------------------------------------------------------
! # The check below checks whether <sys/wait.h> defines the type
! # "union wait" correctly. It's needed because of weirdness in
! # HP-UX where "union wait" is defined in both the BSD and SYS-V
! # environments. Checking the usability of WIFEXITED seems to do
! # the trick.
! #--------------------------------------------------------------------
AC_COMPILE_CHECK([union wait], [#include <sys/types.h>
#include <sys/wait.h>], [
***************
*** 127,146 ****
* uses an int. */
], , AC_DEFINE(NO_UNION_WAIT))
! dnl--------------------------------------------------------------------
! dnl The code below cleans up the DEFS variable to eliminate
! dnl duplicate entries. This makes the eventual make output
! dnl look a bit cleaner.
! dnl--------------------------------------------------------------------
!
! newDefs=""
! for i in $DEFS; do
! if test -z "$newDefs"; then
! newDefs=$i
! elif echo $newDefs | fgrep -v -e $i >/dev/null 2>&1; then
! newDefs="$newDefs $i"
! fi
! done
! DEFS=$newDefs
AC_OUTPUT(Makefile)
--- 131,145 ----
* uses an int. */
], , AC_DEFINE(NO_UNION_WAIT))
! #--------------------------------------------------------------------
! # Check to see whether the system supports the matherr function
! # and its associated type "struct exception".
! #--------------------------------------------------------------------
!
! AC_COMPILE_CHECK([matherr support], [#include <math.h>], [
! struct exception x;
! x.type = DOMAIN;
! x.type = SING;
! ], [LIBOBJS="$LIBOBJS tclMtherr.o"; AC_DEFINE(NEED_MATHERR)])
AC_OUTPUT(Makefile)
*** ../tcl7.0b1/./changes Wed Jul 7 16:25:16 1993
--- ./changes Mon Jul 19 15:12:26 1993
***************
*** 793,796 ****
200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum
allowable nesting depth can be controlled for an interpreter from C.
! ----------------- Released version 7.0 Beta 1, 6/9/93 ------------------
--- 793,827 ----
200. 7/7/93 Added Tcl_SetRecursionLimit procedure so that the maximum
allowable nesting depth can be controlled for an interpreter from C.
! ----------------- Released version 7.0 Beta 1, 7/9/93 ------------------
!
! 201. 7/12/93 Modified Tcl_GetInt and tclExpr.c so that full-precision
! unsigned integers can be specified without overflow errors.
!
! 202. 7/12/93 Configuration changes: eliminate leading blank line in
! configure script; provide separate targets in Makefile for installing
! binary and non-binary information; check for size_t and a few other
! potentially missing typedefs; don't put tclAppInit.o into libtcl.a;
! better checks for matherr support.
!
! 203. 7/14/93 Changed tclExpr.c to check the termination pointer before
! errno after strtod calls, to avoid problems with some versions of
! strtod that set errno in unexpected ways.
!
! 204. 7/16/93 Changed "scan" command to be more ANSI-conformant:
! eliminated %F, %D, etc., added code to ignore "l", "h", and "L"
! modifiers but always convert %e, %f, and %g with implicit "l";
! also added support for %u and %i. Also changed "format" command
! to eliminate %D, %U, %O, and add %i.
! *** POTENTIAL INCOMPATIBILITY ***
!
! 205. 7/17/93 Changed "uplevel" and "upvar" so that they can be used
! from global level to global level: this used to generate an error.
!
! 206. 7/19/93 Renamed "setenv", "putenv", and "unsetenv" procedures
! to avoid conflicts with system procedures with the same names. If
! you want Tcl's procedures to override the system procedures, do it
! in the Makefile (instructions are in the Makefile).
! *** POTENTIAL INCOMPATIBILITY ***
!
! ----------------- Released version 7.0 Beta 2, 7/21/93 ------------------
*** ../tcl7.0b1/./README Fri Jul 9 13:41:00 1993
--- ./README Mon Jul 19 15:07:14 1993
***************
*** 9,15 ****
This directory contains the sources and documentation for Tcl, an
embeddable tool command language. The information here corresponds
! to release 7.0b1, the first beta release of Tcl 7.0.
2. Documentation
----------------
--- 9,15 ----
This directory contains the sources and documentation for Tcl, an
embeddable tool command language. The information here corresponds
! to release 7.0b2, the first beta release of Tcl 7.0.
2. Documentation
----------------
***************
*** 53,62 ****
Tcl commands interactively or execute script files.
(c) If the make fails then you'll have to personalize the Makefile
! for your site. You may also wish to personalize the Makefile to
! modify the install directories, etc. There are comments at the
! beginning of the Makefile that describe the things you might want
! to change and how to change them.
(d) Type "make install" to install Tcl binaries and script files in
standard places. You'll need write permission on /usr/local to
--- 53,63 ----
Tcl commands interactively or execute script files.
(c) If the make fails then you'll have to personalize the Makefile
! for your site or possibly modify the distribution in other ways.
! First check the file "porting.notes" to see if there are hints
! for compiling on your system. If you need to modify Makefile,
! there are comments at the beginning of it that describe the things
! you might want to change and how to change them.
(d) Type "make install" to install Tcl binaries and script files in
standard places. You'll need write permission on /usr/local to
***************
*** 117,127 ****
the built-ins plus many other things, now contains a terse but
complete description of the Tcl language syntax.
! Here is a list of all of incompatibilities that affect Tcl scripts:
1. There have been several changes to backslash processing:
! - Unknown backslash sequences such as "\a" are now replaced with
! the following character (such as "a"); Tcl used to treat the
backslash as an ordinary character in these cases, so both the
backslash and the following character would be passed through.
- Backslash-newline now eats up any white space after the newline,
--- 118,128 ----
the built-ins plus many other things, now contains a terse but
complete description of the Tcl language syntax.
! Here is a list of all incompatibilities that affect Tcl scripts:
1. There have been several changes to backslash processing:
! - Unknown backslash sequences such as "\*" are now replaced with
! the following character (such as "*"); Tcl used to treat the
backslash as an ordinary character in these cases, so both the
backslash and the following character would be passed through.
- Backslash-newline now eats up any white space after the newline,
***************
*** 157,162 ****
--- 158,167 ----
6. The keyword "UNIX" in the variable "errorCode" has been changed to
"POSIX".
+ 7. The "format" and "scan" commands no longer support capitalized
+ conversion specifiers such as "%D" that aren't supported by ANSI
+ sprintf and sscanf.
+
Here is a list of all of the incompatibilities that affect C code that
uses the Tcl library procedures. If you use an ANSI C compiler then
any potential problems will be detected when you compile your code: if
***************
*** 186,191 ****
--- 191,200 ----
8. Tcl_UnixError has been renamed to Tcl_PosixError.
+ 9. Tcl no longer redefines the library procedures "setenv", "putenv",
+ and "unsetenv" by default. You have to set up special configuration
+ in the Makefile if you want this.
+
Below is a sampler of the most important new features in Tcl 7.0. Refer
to the "changes" file for a complete list.
***************
*** 229,236 ****
that can be used to associated a C variable with a Tcl variable and
keep them in sync.
! 10. A new library procedure Tcl_CommandInfo allows you to retrieve
! the clientData of a command.
6. Tcl newsgroup
-----------------
--- 238,246 ----
that can be used to associated a C variable with a Tcl variable and
keep them in sync.
! 10. New library procedures Tcl_SetCommandInfo and Tcl_GetCommandInfo
! allow you to set and get the clientData and callback procedure for
! a command.
6. Tcl newsgroup
-----------------
*** ../tcl7.0b1/./porting.notes Mon Jun 21 09:27:04 1993
--- ./porting.notes Tue Jul 13 16:07:35 1993
***************
*** 113,115 ****
--- 113,124 ----
This brings in the typedef for pid_t, which is needed for
/usr/include/sys/wait.h in tclUnix.h.
+
+ ---------------------------------------------
+ DEC Alphas:
+ ---------------------------------------------
+
+ 1. There appears to be a compiler/library bug that causes core-dumps
+ unless you compile tclVar.c without optimization (remove the -O compiler
+ switch). The problem appears to have been fixed in the 1.3-4 version
+ of the compiler.
*** ../tcl7.0b1/./doc/EnterFile.3 Thu Jul 1 15:23:24 1993
--- ./doc/EnterFile.3 Mon Jul 12 11:00:25 1993
***************
*** 18,24 ****
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/EnterFile.3,v 1.2 93/07/01 15:23:22 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS Tcl_EnterFile tclc 7.0
--- 18,24 ----
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/EnterFile.3,v 1.3 93/07/12 11:00:23 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS Tcl_EnterFile tclc 7.0
***************
*** 78,84 ****
subprocesses, different FILE pointers will be returned for reading
and writing.
\fBTcl_GetOpenFile\fR normally returns TCL_OK.
! If an error occurs in \fBTcl_OpenFile\fR (e.g. \fIstring\fR didn't
make any sense or \fIcheckUsage\fR was set and the file wasn't opened
for the access specified by \fIwrite\fR) then TCL_ERROR is returned
and \fIinterp->result\fR will contain an error message.
--- 78,84 ----
subprocesses, different FILE pointers will be returned for reading
and writing.
\fBTcl_GetOpenFile\fR normally returns TCL_OK.
! If an error occurs in \fBTcl_GetOpenFile\fR (e.g. \fIstring\fR didn't
make any sense or \fIcheckUsage\fR was set and the file wasn't opened
for the access specified by \fIwrite\fR) then TCL_ERROR is returned
and \fIinterp->result\fR will contain an error message.
*** ../tcl7.0b1/./doc/format.n Mon May 3 17:09:44 1993
--- ./doc/format.n Sat Jul 17 15:39:12 1993
***************
*** 18,24 ****
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/format.n,v 1.1 93/05/03 17:09:44 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS format tcl
--- 18,24 ----
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/format.n,v 1.2 93/07/17 15:39:01 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS format tcl
***************
*** 33,56 ****
.SH DESCRIPTION
.PP
This command generates a formatted string in the same way as the
! C \fBsprintf\fR procedure (it uses \fBsprintf\fR in its
! implementation). \fIFormatString\fR indicates how to format
! the result, using \fB%\fR fields as in \fBsprintf\fR, and the additional
arguments, if any, provide values to be substituted into the result.
! All of the \fBsprintf\fR options are valid; see the \fBsprintf\fR
! man page for details.
.VS
The \fBformat\fR command also supports the XPG3 ``%n$'' positional
specifiers.
.VE
- Each \fIarg\fR must match the expected type
- from the \fB%\fR field in \fIformatString\fR; the \fBformat\fR command
- converts each argument to the correct type (floating, integer, etc.)
- before passing it to \fBsprintf\fR for formatting.
- The only unusual conversion is for \fB%c\fR; in this case the argument
- must be a decimal string, which will then be converted to the corresponding
- ASCII character value.
- The return value from \fBformat\fR is the formatted string.
.SH KEYWORDS
format, sprintf, string, substitution
--- 33,72 ----
.SH DESCRIPTION
.PP
This command generates a formatted string in the same way as the
! ANSI C \fBsprintf\fR procedure (it uses \fBsprintf\fR in its
! implementation).
! \fIFormatString\fR indicates how to format the result, using
! \fB%\fR conversion specifiers as in \fBsprintf\fR, and the additional
arguments, if any, provide values to be substituted into the result.
! Each \fIarg\fR must match the expected type
! from the corresponding conversion specifier in \fIformatString\fR;
! the \fBformat\fR command converts each argument to the correct
! type (floating, integer, etc.) before passing it to \fBsprintf\fR
! for formatting.
! The return value from \fBformat\fR is the formatted string.
! .PP
! .VS
! The conversion specifiers for \fBformat\fR are identical in syntax
! and effect to those for \fBsprintf\fR except for the following
! differences:
! .IP [1]
! \fB%p\fR and \fB%n\fR specifiers are not currently supported.
! .VE
! .IP [2]
! For \fB%c\fR conmversions the argument must be a decimal string,
! which will then be converted to the corresponding ASCII character value.
! .IP [3]
.VS
+ The \fBl\fR modifier is ignored; integer values are always converted
+ as if there were no modifier present and real values are always
+ converted as if the \fBl\fR modifier were present (i.e. type
+ \fBdouble\fR is used for the internal representation).
+ If the \fBh\fR modifier is specified then integer values are truncated
+ to \fBshort\fR before conversion.
+ .PP
The \fBformat\fR command also supports the XPG3 ``%n$'' positional
specifiers.
.VE
.SH KEYWORDS
format, sprintf, string, substitution
*** ../tcl7.0b1/./doc/return.n Wed Jul 7 16:37:49 1993
--- ./doc/return.n Fri Jul 16 16:31:18 1993
***************
*** 18,24 ****
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/return.n,v 1.4 93/07/07 16:37:43 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS return tcl 7.0
--- 18,24 ----
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/return.n,v 1.5 93/07/16 16:31:07 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS return tcl 7.0
***************
*** 27,33 ****
.SH NAME
return \- Return from a procedure
.SH SYNOPSIS
! \fBreturn \fR?\fIvalue\fR? ?\fIcode\fR?
.BE
.SH DESCRIPTION
--- 27,33 ----
.SH NAME
return \- Return from a procedure
.SH SYNOPSIS
! \fBreturn \fR?\fB\-code \fIcode\fR? ?\fIstring\fR?
.BE
.SH DESCRIPTION
***************
*** 34,52 ****
.PP
Return immediately from the current procedure
(or top-level command or \fBsource\fR command),
! with \fIvalue\fR as the return value. If \fIvalue\fR is not specified then
an empty string will be returned as result.
.PP
! In the normal case where \fIcode\fR isn't specified the procedure
.VS
! will return normally (its completion code will be TCL_OK).
! However, \fIcode\fR may be used to cause the procedure to return
! with an exceptional completion code, which will generate an exception
! in the script that invoked the current procedure.
\fICode\fR may have any of the following values:
.TP 10
\fBok\fR
! Normal return: same as if \fIcode\fR were omitted.
.TP 10
\fBerror\fR
Error return: same as if the \fBerror\fR command were used to
--- 34,53 ----
.PP
Return immediately from the current procedure
(or top-level command or \fBsource\fR command),
! with \fIstring\fR as the return value. If \fIstring\fR is not specified then
an empty string will be returned as result.
.PP
! In the usual case where the \fB\-code\fR option isn't
.VS
! specified the procedure will return normally (its completion
! code will be TCL_OK).
! However, the \fB\-code\fR option may be used to cause the
! procedure to return with an exceptional completion code,
! which will generate an exception in the script that invoked the procedure.
\fICode\fR may have any of the following values:
.TP 10
\fBok\fR
! Normal return: same as if the option is omitted.
.TP 10
\fBerror\fR
Error return: same as if the \fBerror\fR command were used to
***************
*** 72,78 ****
\fIValue\fR must be an integer; it will be returned as the
completion code for the current procedure.
.LP
! \fICode\fR is rarely used.
It is provided so that procedures that implement
new control structures can reflect exceptional conditions back to
their callers.
--- 73,79 ----
\fIValue\fR must be an integer; it will be returned as the
completion code for the current procedure.
.LP
! The \fB\-code\fR option is rarely used.
It is provided so that procedures that implement
new control structures can reflect exceptional conditions back to
their callers.
*** ../tcl7.0b1/./doc/scan.n Mon Jun 7 16:48:27 1993
--- ./doc/scan.n Fri Jul 16 16:56:14 1993
***************
*** 18,24 ****
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/scan.n,v 1.1 93/06/07 16:48:26 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS scan tcl
--- 18,24 ----
'\" ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
'\" PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
'\"
! '\" $Header: /user6/ouster/tcl/man/RCS/scan.n,v 1.2 93/07/16 16:55:51 ouster Exp $ SPRITE (Berkeley)
'\"
.so man.macros
.HS scan tcl
***************
*** 33,50 ****
.SH DESCRIPTION
.PP
This command parses fields from an input string in the same fashion
! as the C \fBsscanf\fR procedure and returns a count of the number
of fields sucessfully parsed. \fIString\fR gives the input to
be parsed and \fIformat\fR indicates how to parse it, using \fB%\fR
! fields as in \fBsscanf\fR. All of the \fBsscanf\fR options are valid;
! see the \fBsscanf\fR man page for details. Each \fIvarName\fR gives
the name of a variable; when a field is scanned from \fIstring\fR,
the result is converted back into a string and assigned to the
! corresponding \fIvarName\fR. The only unusual conversion is for
! \fB%c\fR. For \fB%c\fR conversions a single character value is
converted to a decimal string, which is then assigned to the
corresponding \fIvarName\fR;
no field width may be specified for this conversion.
.SH KEYWORDS
parse, scan
--- 33,65 ----
.SH DESCRIPTION
.PP
This command parses fields from an input string in the same fashion
! as the ANSI C \fBsscanf\fR procedure and returns a count of the number
of fields sucessfully parsed. \fIString\fR gives the input to
be parsed and \fIformat\fR indicates how to parse it, using \fB%\fR
! fields as in \fBsscanf\fR. Each \fIvarName\fR gives
the name of a variable; when a field is scanned from \fIstring\fR,
the result is converted back into a string and assigned to the
! corresponding \fIvarName\fR.
! All of the \fBsscanf\fR conversion specifiers are valid except for
! the following differences:
! .IP [1]
! .VS
! \fB%p\fR and \fB%n\fR conversion specifiers are not currently
! supported.
! .VE
! .IP [2]
! For \fB%c\fR conversions a single character value is
converted to a decimal string, which is then assigned to the
corresponding \fIvarName\fR;
no field width may be specified for this conversion.
+ .IP [3]
+ .VS
+ The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored; integer
+ values are always converted as if there were no modifier present
+ and real values are always converted as if the \fBl\fR modifier
+ were present (i.e. type \fBdouble\fR is used for the internal
+ representation).
+ .VE
.SH KEYWORDS
parse, scan
*** ../tcl7.0b1/./compat/getcwd.c Thu Jun 3 15:08:50 1993
--- ./compat/getcwd.c Mon Jul 12 14:01:03 1993
***************
*** 26,33 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/strtod.c,v 1.4 93/0
! 3/19 15:25:47 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
--- 26,32 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/getcwd.c,v 1.2 93/07/12 14:00:59 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include "tclInt.h"
*** ../tcl7.0b1/./compat/strtod.c Fri Mar 19 15:25:49 1993
--- ./compat/strtod.c Mon Jul 12 14:01:20 1993
***************
*** 25,35 ****
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/strtod.c,v 1.4 93/03/19 15:25:47 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include <tcl.h>
! #include <stdlib.h>
#include <ctype.h>
#ifndef TRUE
--- 25,39 ----
*/
#ifndef lint
! static char rcsid[] = "$Header: /user6/ouster/tcl/compat/RCS/strtod.c,v 1.5 93/07/12 14:01:07 ouster Exp $ SPRITE (Berkeley)";
#endif /* not lint */
#include <tcl.h>
! #ifdef NO_STDLIB_H
! # include "compat/stdlib.h"
! #else
! # include <stdlib.h>
! #endif
#include <ctype.h>
#ifndef TRUE
*** ../tcl7.0b1/./compat/unistd.h Thu Jun 3 15:08:41 1993
--- ./compat/unistd.h Fri Jul 16 09:32:52 1993
***************
*** 12,18 ****
* software for any purpose. It is provided "as is" without
* express or implied warranty.
*
! * $Header: /user6/ouster/tcl/compat/RCS/unistd.h,v 1.1 93/06/03 15:08:39 ouster Exp $
*/
#ifndef _UNISTD
--- 12,18 ----
* software for any purpose. It is provided "as is" without
* express or implied warranty.
*
! * $Header: /user6/ouster/tcl/compat/RCS/unistd.h,v 1.2 93/07/16 09:32:43 ouster Exp $
*/
#ifndef _UNISTD
***************
*** 77,83 ****
extern int ttyslot _ANSI_ARGS_((void));
extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
extern int umask _ANSI_ARGS_((int cmask));
! extern _VoidPtr valloc _ANSI_ARGS_((size_t bytes));
extern int vfork _ANSI_ARGS_((void));
#endif /* _POSIX_SOURCE */
--- 77,83 ----
extern int ttyslot _ANSI_ARGS_((void));
extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
extern int umask _ANSI_ARGS_((int cmask));
! extern VOID valloc _ANSI_ARGS_((size_t bytes));
extern int vfork _ANSI_ARGS_((void));
#endif /* _POSIX_SOURCE */
*** ../tcl7.0b1/./tests/expr.test Wed Jul 7 16:23:14 1993
--- ./tests/expr.test Mon Jul 12 11:35:07 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/expr.test,v 1.22 93/07/07 16:21:32 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/expr.test,v 1.23 93/07/12 11:34:55 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 309,316 ****
set y 10
expr {$x + $y}
} {5}
! test expr-22.3 {embedded commands and variables} {expr {[set a] - 14}} 2
! test expr-22.4 {embedded commands and variables} {
list [catch {expr {12 - [bad_command_name]}} msg] $msg
} {1 {invalid command name: "bad_command_name"}}
--- 309,321 ----
set y 10
expr {$x + $y}
} {5}
! test expr-22.3 {embedded variables} {
! set x " -5"
! set y " +10"
! expr {$x + $y}
! } {5}
! test expr-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
! test expr-22.5 {embedded commands and variables} {
list [catch {expr {12 - [bad_command_name]}} msg] $msg
} {1 {invalid command name: "bad_command_name"}}
*** ../tcl7.0b1/./tests/format.test Wed Jul 7 16:21:32 1993
--- ./tests/format.test Sat Jul 17 15:25:07 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/format.test,v 1.14 93/07/07 16:21:15 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/format.test,v 1.16 93/07/17 15:25:01 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 57,66 ****
} { 6 34 16923 4294967284 -1 0}
}
test format-1.4 {integer formatting} {
! format "%-4d %-4d %-4d %-4ld" 6 34 16923 -12 -1
} {6 34 16923 -12 }
test format-1.5 {integer formatting} {
! format "%04d %04d %04d %04d" 6 34 16923 -12 -1
} {0006 0034 16923 -012}
test format-1.6 {integer formatting} {
format "%00*d" 6 34
--- 57,66 ----
} { 6 34 16923 4294967284 -1 0}
}
test format-1.4 {integer formatting} {
! format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1
} {6 34 16923 -12 }
test format-1.5 {integer formatting} {
! format "%04d %04d %04d %04i" 6 34 16923 -12 -1
} {0006 0034 16923 -012}
test format-1.6 {integer formatting} {
format "%00*d" 6 34
***************
*** 339,347 ****
test format-9.3 {"h" format specifier} {
format %hd 0x10000
} 0
- test format-9.4 {"h" format specifier} {
- format %hD 0x10000
- } 65536
}
test format-10.1 {XPG3 %$n specifiers} {
--- 339,344 ----
*** ../tcl7.0b1/./tests/incr.test Wed Jun 16 10:58:09 1993
--- ./tests/incr.test Mon Jul 12 11:34:52 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/incr.test,v 1.4 93/06/16 10:57:48 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/incr.test,v 1.5 93/07/12 11:34:43 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 38,43 ****
--- 38,51 ----
set x 106
list [incr x -5] $x
} {101 101}
+ test incr-1.3 {basic incr operation} {
+ set x " -106"
+ list [incr x 1] $x
+ } {-105 -105}
+ test incr-1.3 {basic incr operation} {
+ set x " +106"
+ list [incr x 1] $x
+ } {107 107}
test incr-2.1 {incr errors} {
list [catch incr msg] $msg
*** ../tcl7.0b1/./tests/proc.test Wed Jun 16 15:59:07 1993
--- ./tests/proc.test Fri Jul 16 15:27:56 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/proc.test,v 1.13 93/06/16 15:58:55 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/proc.test,v 1.14 93/07/16 15:27:50 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 279,287 ****
catch {return}
} 2
test proc-5.9 {error conditions} {
! list [catch {return 1 2 3} msg] $msg
! } {1 {wrong # args: should be "return ?value? ?code?"}}
test proc-5.10 {error conditions} {
list [catch {global} msg] $msg
} {1 {wrong # args: should be "global varName ?varName ...?"}}
proc tproc {} {
--- 279,290 ----
catch {return}
} 2
test proc-5.9 {error conditions} {
! list [catch {return 1 2 3 4} msg] $msg
! } {1 {wrong # args: should be "return ?-code code? ?string?"}}
test proc-5.10 {error conditions} {
+ list [catch {return -coed 3} msg] $msg
+ } {1 {wrong # args: should be "return ?-code code? ?string?"}}
+ test proc-5.11 {error conditions} {
list [catch {global} msg] $msg
} {1 {wrong # args: should be "global varName ?varName ...?"}}
proc tproc {} {
***************
*** 288,297 ****
set a 22
global a
}
! test proc-5.11 {error conditions} {
list [catch {tproc} msg] $msg
} {1 {variable "a" already exists}}
! test proc-5.12 {error conditions} {
catch {rename tproc {}}
catch {
proc tproc {x {} z} {return foo}
--- 291,300 ----
set a 22
global a
}
! test proc-5.12 {error conditions} {
list [catch {tproc} msg] $msg
} {1 {variable "a" already exists}}
! test proc-5.13 {error conditions} {
catch {rename tproc {}}
catch {
proc tproc {x {} z} {return foo}
***************
*** 298,304 ****
}
list [catch {tproc 1} msg] $msg
} {1 {invalid command name: "tproc"}}
! test proc-5.13 {error conditions} {
proc tproc {} {
set a 22
error "error in procedure"
--- 301,307 ----
}
list [catch {tproc 1} msg] $msg
} {1 {invalid command name: "tproc"}}
! test proc-5.14 {error conditions} {
proc tproc {} {
set a 22
error "error in procedure"
***************
*** 306,312 ****
}
list [catch tproc msg] $msg
} {1 {error in procedure}}
! test proc-5.14 {error conditions} {
proc tproc {} {
set a 22
error "error in procedure"
--- 309,315 ----
}
list [catch tproc msg] $msg
} {1 {error in procedure}}
! test proc-5.15 {error conditions} {
proc tproc {} {
set a 22
error "error in procedure"
***************
*** 320,326 ****
(procedure "tproc" line 3)
invoked from within
"tproc"}
! test proc-5.15 {error conditions} {
proc tproc {} {
set a 22
break
--- 323,329 ----
(procedure "tproc" line 3)
invoked from within
"tproc"}
! test proc-5.16 {error conditions} {
proc tproc {} {
set a 22
break
***************
*** 331,337 ****
} {invoked "break" outside of a loop
while executing
"tproc"}
! test proc-5.16 {error conditions} {
proc tproc {} {
set a 22
continue
--- 334,340 ----
} {invoked "break" outside of a loop
while executing
"tproc"}
! test proc-5.17 {error conditions} {
proc tproc {} {
set a 22
continue
***************
*** 364,370 ****
} 45
proc tproc code {
! return abc $code
}
test proc-7.1 {return with special completion code} {
list [catch {tproc ok} msg] $msg
--- 367,373 ----
} 45
proc tproc code {
! return -code $code abc
}
test proc-7.1 {return with special completion code} {
list [catch {tproc ok} msg] $msg
***************
*** 396,398 ****
--- 399,407 ----
}
list [catch tproc2 msg] $msg
} {0 abc}
+ test proc-7.10 {return with special completion code} {
+ proc tproc2 {} {
+ return -code error
+ }
+ list [catch tproc2 msg] $msg
+ } {1 {}}
*** ../tcl7.0b1/./tests/scan.test Thu Jun 3 10:35:58 1993
--- ./tests/scan.test Fri Jul 16 16:50:42 1993
***************
*** 24,545 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/scan.test,v 1.14 93/06/03 10:35:48 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
test scan-1.1 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "-20 1476 \n33 0" "%d %d %d %d" a b c d
! } 4
test scan-1.2 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "-20 1476 \n33 0" "%d %d %d %d" a b c d
! set a
! } -20
test scan-1.3 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "-20 1476 \n33 0" "%d %d %d %d" a b c d
! set b
! } 1476
test scan-1.4 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "-20 1476 \n33 0" "%d %d %d %d" a b c d
! set c
! } 33
test scan-1.5 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "-20 1476 \n33 0" "%d %d %d %d" a b c d
! set d
! } 0
test scan-1.6 {integer scanning} {
! set a {}; set b {}; set c {}
! scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c
! } 3
test scan-1.7 {integer scanning} {
! set a {}; set b {}; set c {}
! scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c
! set a
! } -4
test scan-1.8 {integer scanning} {
! set a {}; set b {}; set c {}
! scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c
! set b
! } 16
test scan-1.9 {integer scanning} {
! set a {}; set b {}; set c {}
! scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c
! set c
! } 7890
!
! # Capitalized format specifiers don't work on some systems, so
! # only run the following tests at Berkeley.
!
if $atBerkeley {
- test scan-1.10 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-45 16 +10 987" "%D %d %D %d" a b c d
- } 4
test scan-1.11 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "-45 16 +10 987" "%D %d %D %d" a b c d
! set a
! } -45
! test scan-1.12 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "-45 16 +10 987" "%D %d%D %d" a b c d
! set b
! } 16
! test scan-1.13 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "-45 16 +10 987" "%D %d %D %d" a b c d
! set c
! } 10
! test scan-1.14 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "-45 16 +10 987" "%D %d %D %d" a b c d
! set d
! } 987
! test scan-1.15 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "14 1ab 62 10" "%d %x %O %x" a b c d
! } 4
! test scan-1.16 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "14 1ab 62 10" "%d %x %O %x" a b c d
! set a
! } 14
! test scan-1.17 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "14 1ab 62 10" "%d %x %O %x" a b c d
! set b
! } 427
! test scan-1.18 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "14 1ab 62 10" "%d %x %O %x" a b c d
! set c
! } 50
! test scan-1.19 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "14 1ab 62 10" "%d %x %O %x" a b c d
! set d
! } 16
! test scan-1.20 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "12345670 1234567890ab cdefg" "%o %o %x %X" a b c d
! } 4
}
- test scan-1.21 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345670 1234567890ab cdefg" "%o %o %x %X" a b c d
- set a
- } 2739128
- test scan-1.22 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345670 1234567890ab cdefg" "%o %o %x %X" a b c d
- set b
- } 342391
- test scan-1.23 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345670 1234567890ab cdefg" "%o %o %x %X" a b c d
- set c
- } 561323
- test scan-1.24 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345670 1234567890ab cdefg" "%o %o %x %X" a b c d
- set d
- } 52719
- test scan-1.25 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "ab123-24642" "%2x %3x %3o %2o" a b c d
- } 4
- test scan-1.26 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "ab123-24642" "%2x %3x %3o %2o" a b c d
- set a
- } 171
- test scan-1.27 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "ab123-24642" "%2x %3x %3o %2o" a b c d
- set b
- } 291
- test scan-1.28 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "ab123-24642" "%2x %3x %3o %2o" a b c d
- set c
- } -20
- test scan-1.29 {integer scanning} {
- set a {}; set b {}
- scan "ab123-24642" "%2x %3x %3o %2o" a b c d
- set d
- } 52
- test scan-1.30 {integer scanning} {
- set a {}; set b {}
- scan "1234567 234 567 " "%*3x %x %*o %4o" a b
- } 2
- test scan-1.31 {integer scanning} {
- set a {}; set b {}
- scan "1234567 234 567 " "%*3x %x %*o %4o" a b
- set a
- } 17767
- test scan-1.32 {integer scanning} {
- set a {}; set b {}
- scan "a 1234" "%d %d" a b
- } 0
- test scan-1.33 {integer scanning} {
- set a {}
- scan "a 1234" "%d %d" a b
- set a
- } {}
- test scan-1.34 {integer scanning} {
- set a {}; set b {}; set c {}; set d {};
- scan "12345678" "%2d %2d %2d %2d" a b c d
- } 4
- test scan-1.35 {integer scanning} {
- set a {}; set b {}; set c {}; set d {};
- scan "12345678" "%2d %2d %2d %2d" a b c d
- set a
- } 12
- test scan-1.36 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345678" "%2d %2d %2d %2d" a b c d
- set b
- } 34
- test scan-1.37 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345678" "%2d %2d %2d %2d" a b c d
- set c
- } 56
- test scan-1.38 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "12345678" "%2d %2d %2d %2d" a b c d
- set d
- } 78
- test scan-1.39 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2 " "%d %d %d %d" a b c d
- } 2
- test scan-1.40 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2 " "%d %d %d %d" a b c d
- set a
- } 1
- test scan-1.41 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2 " "%d %d %d %d" a b c d
- set b
- } 2
- test scan-1.42 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2 " "%d %d %d %d" a b c d
- } 2
- test scan-1.43 {integer scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2 " "%d %d %d %d" a b c d
- set d
- } {}
test scan-2.1 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "2.1 -3.0e8 .99962 a" "%f%f%f%f" a b c d
! } 3
test scan-2.2 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "2.1 -3.0e8 .99962 a" "%f%f%f%f" a b c d
! set a
! } 2.1
test scan-2.3 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "2.1 -3.0e8 .99962 a" "%f%f%f%f" a b c d
- set b
- } -3e+08
- test scan-2.4 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "2.1 -3.0e8 .99962 a" "%f%f%f%f" a b c d
- set c
- } 0.99962
- test scan-2.5 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "2.1 -3.0e8 .99962 a" "%f%f%f%f" a b c d
- set d
- } {}
- test scan-2.6 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-1.2345 +8.2 9" "%3e %3f %f %f" a b c d
- } 4
- test scan-2.7 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-1.2345 +8.2 9" "%3e %3f %f %f" a b c d
- set a
- } -1.0
- test scan-2.8 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-1.2345 +8.2 9" "%3e %3f %f %f" a b c d
- set b
- } 234.0
- test scan-2.9 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-1.2345 +8.2 9" "%3e %3f %f %f" a b c d
- set c
- } 5.0
- test scan-2.10 {floating-point scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "-1.2345 +8.2 9" "%3e %3f %f %f" a b c d
- set d
- } 8.2
- test scan-2.11 {floating-point scanning} {
set a {}; set b {}; set c {}
! scan "1e00004 332E-4 3e+4" "%f %*2e %f %f" a b c
! } 3
! test scan-2.12 {floating-point scanning} {
! set a {}; set b {}; set c {}
! scan "1e00004 332E-4 3e+4" "%f %*2e %f %f" a b c
! set a
! } 10000.0
! test scan-2.13 {floating-point scanning} {
! set a {}; set b {}; set c {}
! scan "1e00004 332E-4 3e+4" "%f %*2e %f %f" a b c
! set c
! } 30000.0
! if $atBerkeley {
! test scan-2.14 {floating-point scanning} {
! set a {}; set b {}; set c {}
! scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c
! } 3
! }
! test scan-2.15 {floating-point scanning} {
! set a {}; set b {}; set c {}
! scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c
! set a
! } 1.0
! test scan-2.16 {floating-point scanning} {
! set a {}; set b {}; set c {}
! scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c
! set b
! } 200.0
if $atBerkeley {
! test scan-2.17 {floating-point scanning} {
set a {}; set b {}; set c {}
! scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c
! set c
! } 3.0
! test scan-2.18 {floating-point scanning} {
set a {}; set b {}
! scan "1.eabc" "%f %x" a b
! } 2
! test scan-2.19 {floating-point scanning} {
! set a {}; set b {}
! scan "1.eabc" "%f %x" a b
! set a
! } 1.0
}
! test scan-2.20 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d
! } 4
! test scan-2.21 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d
! set a
! } 4.6
! test scan-2.22 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d
! set b
! } 99999.7
! test scan-2.23 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d
! set c
! } 87.643
! test scan-2.24 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d
! set d
! } 118.0
! test scan-2.25 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d
! } 4
! test scan-2.26 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d
! set a
! } 1.2345
! test scan-2.27 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d
! set b
! } 0.697
! test scan-2.28 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d
! set c
! } 124.0
! test scan-2.29 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d
! set d
! } 5e-05
! test scan-2.30 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6abc" "%f %f %f %f" a b c d
! } 1
! test scan-2.31 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6abc" "%f %f %f %f" a b c d
! set a
! } 4.6
! test scan-2.32 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "4.6abc" "%f %f %f %f" a b c d
! set b
! } {}
! test scan-2.33 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6abc" "%f %f %f %f" a b c d
! set c
! } {}
! test scan-2.34 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6abc" "%f %f %f %f" a b c d
! set d
! } {}
! test scan-2.35 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 5.2" "%f %f %f %f" a b c d
! } 2
! test scan-2.36 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "4.6 5.2" "%f %f %f %f" a b c d
! set a
! } 4.6
! test scan-2.37 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "4.6 5.2" "%f %f %f %f" a b c d
! set b
! } 5.2
! test scan-2.38 {floating-point scanning} {
! set a {}; set b {}; set c {}; set d {}
! scan "4.6 5.2" "%f %f %f %f" a b c d
! set c
! } {}
! test scan-2.39 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "4.6 5.2" "%f %f %f %f" a b c d
! set d
! } {}
test scan-3.1 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "abc defghijk dum " "%s %3s %20s %s" a b c d
! } 4
test scan-3.2 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
! scan "abc defghijk dum " "%s %3s %20s %s" a b c d
! set a
! } abc
test scan-3.3 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "abc defghijk dum " "%s %3s %20s %s" a b c d
- set b
- } def
- test scan-3.4 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "abc defghijk dum " "%s %3s %20s %s" a b c d
- set c
- } ghijk
- test scan-3.5 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "abc defghijk dum " "%s %3s %20s %s" a b c d
- set d
- } dum
- test scan-3.6 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "a bcdef" "%c%c%1s %s" a b c d
- } 4
- test scan-3.7 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "a bcdef" "%c%c%1s %s" a b c d
- set a
- } 97
- test scan-3.8 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "a bcdef" "%c%c%1s %s" a b c d
- set b
- } 32
- test scan-3.9 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "a bcdef" "%c%c%1s %s" a b c d
- set c
- } b
- test scan-3.10 {string and character scanning} {
- set a {}; set b {}; set c {}; set d {}
- scan "a bcdef" "%c%c%1s %s" a b c d
- set d
- } cdef
- test scan-3.11 {string and character scanning} {
- set a {}; set b {}; set c {}
- scan "123456 test " "%*c%*s %s %s %s" a b c
- } 1
- test scan-3.12 {string and character scanning} {
set a {}; set b {}; set c {}
! scan "123456 test " "%*c%*s %s %s %s" a b c
! set a
! } test
! test scan-3.13 {string and character scanning} {
! set a {}; set b {}; set c {}
! scan "123456 test " "%*c%*s %s %s %s" a b c
! set b
! } {}
! test scan-3.14 {string and character scanning} {
! set a {}; set b {}; set c {}
! scan "123456 test " "%*c%*s %s %s %s" a b c
! set c
! } {}
! test scan-3.15 {string and character scanning} {
! set a {}; set b {}; set c {}; set d
! scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d
! } 4
! test scan-3.16 {string and character scanning} {
! set a {}; set b {}; set c {}; set d
! scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d
! set a
! } abab
! test scan-3.17 {string and character scanning} {
! set a {}; set b {}; set c {}; set d
! scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d
! set b
! } cd
! test scan-3.18 {string and character scanning} {
! set a {}; set b {}; set c {}; set d
! scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d
! set c
! } {01234 }
! test scan-3.19 {string and character scanning} {
set a {}; set b {}; set c {}; set d
! scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d
! set d
! } {f 12345}
! test scan-3.20 {string and character scanning} {
! set a {}; set b {}; set c {}
! scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c
! } 3
! test scan-3.21 {string and character scanning} {
! set a {}; set b {}; set c {}
! scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c
! set a
! } aabc
! test scan-3.22 {string and character scanning} {
! set a {}; set b {}; set c {}
! scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c
! set b
! } bcdefg
! test scan-3.23 {string and character scanning} {
set a {}; set b {}; set c {}
! scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c
! set c
! } 43
test scan-4.1 {error conditions} {
catch {scan a}
--- 24,140 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/scan.test,v 1.16 93/07/16 16:50:35 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
test scan-1.1 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
! } {4 -20 1476 33 0}
test scan-1.2 {integer scanning} {
! set a {}; set b {}; set c {}
! list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
! } {3 -4 16 7890}
test scan-1.3 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
! } {4 -45 16 10 987}
test scan-1.4 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
! } {4 14 427 50 16}
test scan-1.5 {integer scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "12345670 1234567890ab cdefg" "%o %o %x %lx" a b c d] \
! $a $b $c $d
! } {4 2739128 342391 561323 52719}
test scan-1.6 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
! } {4 171 291 -20 52}
test scan-1.7 {integer scanning} {
! set a {}; set b {}
! list [scan "1234567 234 567 " "%*3x %x %*o %4o" a b] $a $b
! } {2 17767 375}
test scan-1.8 {integer scanning} {
! set a {}; set b {}
! list [scan "a 1234" "%d %d" a b] $a $b
! } {0 {} {}}
test scan-1.9 {integer scanning} {
! set a {}; set b {}; set c {}; set d {};
! list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
! } {4 12 34 56 78}
! test scan-1.10 {integer scanning} {
! set a {}; set b {}; set c {}; set d {}
! list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
! } {2 1 2 {} {}}
if $atBerkeley {
test scan-1.11 {integer scanning} {
! set a {}; set b {};
! list [scan "4294967280 4294967280" "%u %d" a b] $a $b
! } {2 4294967280 -16}
}
test scan-2.1 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
! } {3 2.1 -3e+08 0.99962 {}}
test scan-2.2 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
! } {4 -1.0 234.0 5.0 8.2}
test scan-2.3 {floating-point scanning} {
set a {}; set b {}; set c {}
! list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
! } {3 10000.0 30000.0}
if $atBerkeley {
! test scan-2.4 {floating-point scanning} {
set a {}; set b {}; set c {}
! list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
! } {3 1.0 200.0 3.0}
! test scan-2.5 {floating-point scanning} {
set a {}; set b {}
! list [scan "1.eabc" "%f %x" a b] $a $b
! } {2 1.0 2748}
}
! test scan-2.6 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
! } {4 4.6 99999.7 87.643 118.0}
! test scan-2.7 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
! } {4 1.2345 0.697 124.0 5e-05}
! test scan-2.8 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
! } {1 4.6 {} {} {}}
! test scan-2.9 {floating-point scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
! } {2 4.6 5.2 {} {}}
test scan-3.1 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
! } {4 abc def ghijk dum}
test scan-3.2 {string and character scanning} {
set a {}; set b {}; set c {}; set d {}
! list [scan "a bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
! } {4 97 32 b cdef}
test scan-3.3 {string and character scanning} {
set a {}; set b {}; set c {}
! list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
! } {1 test {} {}}
! test scan-3.4 {string and character scanning} {
set a {}; set b {}; set c {}; set d
! list [scan "ababcd01234 f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
! } {4 abab cd {01234 } {f 12345}}
! test scan-3.5 {string and character scanning} {
set a {}; set b {}; set c {}
! list [scan "aaaaaabc aaabcdefg + + XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
! } {3 aabc bcdefg 43}
test scan-4.1 {error conditions} {
catch {scan a}
***************
*** 556,656 ****
set msg
} {too many fields to scan}
test scan-4.5 {error conditions} {
! catch {scan a %z}
! } 1
test scan-4.6 {error conditions} {
! catch {scan a %z} msg
! set msg
! } {bad scan conversion character "z"}
test scan-4.7 {error conditions} {
! catch {scan a "%d %d" a}
! } 1
test scan-4.8 {error conditions} {
! catch {scan a "%d %d" a} msg
! set msg
! } {different numbers of variable names and field specifiers}
test scan-4.9 {error conditions} {
! catch {scan a "%d %d" a b c}
! } 1
test scan-4.10 {error conditions} {
! catch {scan a "%d %d" a b c} msg
! set msg
! } {different numbers of variable names and field specifiers}
test scan-4.11 {error conditions} {
! set a {}; set b {}; set c {}; set d {}
! expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}
! } 1
test scan-4.12 {error conditions} {
set a {}; set b {}; set c {}; set d {}
! scan " a" " a %d %d %d %d" a b c d
! set a
! } {}
test scan-4.13 {error conditions} {
set a {}; set b {}; set c {}; set d {}
! scan " a" " a %d %d %d %d" a b c d
! set b
! } {}
test scan-4.14 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan " a" " a %d %d %d %d" a b c d
- set c
- } {}
- test scan-4.15 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan " a" " a %d %d %d %d" a b c d
- set d
- } {}
- test scan-4.16 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2" "%d %d %d %d" a b c d
- } 2
- test scan-4.17 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2" "%d %d %d %d" a b c d
- set a
- } 1
- test scan-4.18 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2" "%d %d %d %d" a b c d
- set b
- } 2
- test scan-4.19 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2" "%d %d %d %d" a b c d
- set c
- } {}
- test scan-4.20 {error conditions} {
- set a {}; set b {}; set c {}; set d {}
- scan "1 2" "%d %d %d %d" a b c d
- set d
- } {}
- test scan-4.21 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %d a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.22 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %c a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.23 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %s a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.24 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.25 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
catch {unset a}
! test scan-4.26 {error conditions} {
list [catch {scan 44 %2c a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
--- 151,211 ----
set msg
} {too many fields to scan}
test scan-4.5 {error conditions} {
! list [catch {scan a %D} msg] $msg
! } {1 {bad scan conversion character "D"}}
test scan-4.6 {error conditions} {
! list [catch {scan a %O} msg] $msg
! } {1 {bad scan conversion character "O"}}
test scan-4.7 {error conditions} {
! list [catch {scan a %X} msg] $msg
! } {1 {bad scan conversion character "X"}}
test scan-4.8 {error conditions} {
! list [catch {scan a %F} msg] $msg
! } {1 {bad scan conversion character "F"}}
test scan-4.9 {error conditions} {
! list [catch {scan a %E} msg] $msg
! } {1 {bad scan conversion character "E"}}
test scan-4.10 {error conditions} {
! list [catch {scan a "%d %d" a} msg] $msg
! } {1 {different numbers of variable names and field specifiers}}
test scan-4.11 {error conditions} {
! list [catch {scan a "%d %d" a b c} msg] $msg
! } {1 {different numbers of variable names and field specifiers}}
test scan-4.12 {error conditions} {
set a {}; set b {}; set c {}; set d {}
! list [expr {[scan " a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
! } {1 {} {} {} {}}
test scan-4.13 {error conditions} {
set a {}; set b {}; set c {}; set d {}
! list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
! } {2 1 2 {} {}}
test scan-4.14 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %d a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.15 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %c a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.16 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %s a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.17 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
! test scan-4.18 {error conditions} {
catch {unset a}
set a(0) 44
list [catch {scan 44 %f a} msg] $msg
} {1 {couldn't set variable "a"}}
catch {unset a}
! test scan-4.19 {error conditions} {
list [catch {scan 44 %2c a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
***************
*** 687,693 ****
test scan-6.6 {miscellaneous tests} {
set tcl_precision 10
set a {}
! scan 1.111122223333 %F a
unset tcl_precision
set a
} {1.111122223}
--- 242,255 ----
test scan-6.6 {miscellaneous tests} {
set tcl_precision 10
set a {}
! scan 1.111122223333 %lf a
! unset tcl_precision
! set a
! } {1.111122223}
! test scan-6.7 {miscellaneous tests} {
! set tcl_precision 10
! set a {}
! scan 1.111122223333 %f a
unset tcl_precision
set a
} {1.111122223}
*** ../tcl7.0b1/./tests/uplevel.test Sat Feb 6 15:54:01 1993
--- ./tests/uplevel.test Sat Jul 17 14:38:25 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/uplevel.test,v 1.10 93/02/06 15:54:00 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/uplevel.test,v 1.11 93/07/17 14:38:22 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 75,97 ****
test uplevel-2.5 {relative and absolute uplevel} {set x} 555
test uplevel-2.6 {relative and absolute uplevel} {set y} 666
! test uplevel-3.1 {error: non-existent level} {
list [catch c1 msg] $msg
} {1 {bad level "#2"}}
! test uplevel-3.2 {error: non-existent level} {
proc c2 {} {uplevel 3 {set a b}}
list [catch c2 msg] $msg
} {1 {bad level "3"}}
! test uplevel-3.3 {error: already at global level} {
! list [catch {uplevel gorp} msg] $msg
! } {1 {already at top level}}
! test uplevel-3.4 {error: already at global level} {
! list [catch {uplevel 1 gorp} msg] $msg
! } {1 {already at top level}}
! test uplevel-3.5 {error: not enough args} {
list [catch uplevel msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
! test uplevel-3.6 {error: not enough args} {
proc upBug {} {uplevel 1}
list [catch upBug msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
--- 75,111 ----
test uplevel-2.5 {relative and absolute uplevel} {set x} 555
test uplevel-2.6 {relative and absolute uplevel} {set y} 666
! test uplevel-3.1 {uplevel to same level} {
! set x 33
! uplevel #0 set x 44
! set x
! } 44
! test uplevel-3.2 {uplevel to same level} {
! set x 33
! uplevel 0 set x
! } 33
! test uplevel-3.3 {uplevel to same level} {
! set y xxx
! proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
! a1
! } 66
! test uplevel-3.4 {uplevel to same level} {
! set y zzz
! proc a1 {} {set y 55; uplevel #1 set y}
! a1
! } 55
!
! test uplevel-4.1 {error: non-existent level} {
list [catch c1 msg] $msg
} {1 {bad level "#2"}}
! test uplevel-4.2 {error: non-existent level} {
proc c2 {} {uplevel 3 {set a b}}
list [catch c2 msg] $msg
} {1 {bad level "3"}}
! test uplevel-4.3 {error: not enough args} {
list [catch uplevel msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
! test uplevel-4.4 {error: not enough args} {
proc upBug {} {uplevel 1}
list [catch upBug msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
***************
*** 105,109 ****
set y [info level 1]
}
a2
! test uplevel-4.1 {info level} {set x} 1
! test uplevel-4.2 {info level} {set y} a3
--- 119,123 ----
set y [info level 1]
}
a2
! test uplevel-5.1 {info level} {set x} 1
! test uplevel-5.2 {info level} {set y} a3
*** ../tcl7.0b1/./tests/upvar.test Sat May 1 16:01:11 1993
--- ./tests/upvar.test Sat Jul 17 14:38:22 1993
***************
*** 24,30 ****
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/upvar.test,v 1.3 93/05/01 16:01:10 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
--- 24,30 ----
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
! # $Header: /user6/ouster/tcl/tests/RCS/upvar.test,v 1.4 93/07/17 14:38:10 ouster Exp $ (Berkeley)
if {[string compare test [info procs test]] == 1} then {source defs}
***************
*** 256,281 ****
p1
} {abcde 44}
! test upvar-7.1 {errors in upvar command} {
list [catch upvar msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-7.2 {errors in upvar command} {
list [catch {upvar 1} msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-7.3 {errors in upvar command} {
! list [catch {upvar a b} msg] $msg
! } {1 {already at top level}}
! test upvar-7.4 {errors in upvar command} {
! list [catch {upvar 1 a b} msg] $msg
! } {1 {already at top level}}
! test upvar-7.5 {errors in upvar command} {
! list [catch {upvar #0 a b} msg] $msg
! } {1 {already at top level}}
! test upvar-7.6 {errors in upvar command} {
proc p1 {} {upvar a b c}
list [catch p1 msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-7.7 {errors in upvar command} {
proc p1 {} {set a 33; upvar b a}
list [catch p1 msg] $msg
} {1 {variable "a" already exists}}
--- 256,303 ----
p1
} {abcde 44}
! test upvar-7.1 {upvar to same level} {
! set x 44
! set y 55
! catch {unset uv}
! upvar #0 x uv
! set uv abc
! upvar 0 y uv
! set uv xyzzy
! list $x $y
! } {abc xyzzy}
! test upvar-7.2 {upvar to same level} {
! set x 1234
! set y 4567
! proc p1 {x y} {
! upvar 0 x uv
! set uv $y
! return "$x $y"
! }
! p1 44 89
! } {89 89}
! test upvar-7.3 {upvar to same level} {
! set x 1234
! set y 4567
! proc p1 {x y} {
! upvar #1 x uv
! set uv $y
! return "$x $y"
! }
! p1 xyz abc
! } {abc abc}
!
! test upvar-8.1 {errors in upvar command} {
list [catch upvar msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-8.2 {errors in upvar command} {
list [catch {upvar 1} msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-8.3 {errors in upvar command} {
proc p1 {} {upvar a b c}
list [catch p1 msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
! test upvar-8.4 {errors in upvar command} {
proc p1 {} {set a 33; upvar b a}
list [catch p1 msg] $msg
} {1 {variable "a" already exists}}